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ABSTRACT 


The  Mach  box  technique  has  been  extended  to  include  wing  and  tail  with 
dihedral  angles  and  vertical  separation.  A  digital  computer  program,  written 
in  FORTRAN,  is  presented.  The  program  provides  for  up  to  nine  sweep  angles  of 
the  leading  and  trailing  edges  of  each  surface.  First  order  piston  theory 
thickness  correction  is  available  as  an  option,  and  two  refinement  procedures 
are  provided,  subdivision  with  averaging  and  velocity  potential  smoothing. 

For  a  maximum  of  twenty  oscillatory  mode  shapes  the  program  calculates 
normal  washes,  velocity  potentials,  lifts,  pressures  and  generalized  forces 
matrices.  If  only  one  surface  is  being  analyzed,  sampling  of  wake  up-wash, 
side-wash  and  longitudinal  wash  is  available. 
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NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

a 

length/time 

Speed  of  Sound  »  U/M 

A(n,m) 

area 

Integration  area  of  box  n,ra 

bl 

Bl 

length 

Chordwise  dimension  of  Mach  box. 

bis 

BIS 

length 

bl^S  “  chordwise  dimension  of  a 

subdivided  box. 

C 

non- 

dimensional 

Velocity  potential  spatial  aerodynamic 
influence  coefficient  (AIC). 

(») 

cp/a 

C 

non- 

dimensional 

Spatial  AIC  giving  velocity  potential 
at  a  point  on.  surface  "xy"  due  to 
constant  outward  normal  wash  over 
a  box  on  surface  "ab";  possible  values 
for  superscripts  are 

/R-right  (W-wing 

X°ra  \L-left  *orblT-tail 

cP/Lo> 

C  i>fl 

PKERNL 

non- 

dimensional 

Velocity  potential  planar  AIC 

S 

CP/iO 

SKERNL 

non- 

dimensional 

Planar  AIC  defined  for  subdivided 
sending  boxes. 

_  n,m 

DELCP 

1/length 

Pressure  coefficient difference 
at  box  n,ra  for  the  J  mode  (program 
output) 

V  c 

— 

length 

Local  reference  chord 

vi 


NOMENCLATURE 


Mathe- 

FORTRAN 

mac leal 
Symbol 

Symbol 

Dlmena ion 

Def init Ion 

‘;”o 

— 

1/ length 

Local  lift  coefficient  per  unit 
ppan  for  the  j  mode 

cm 

SECMOM 

1/ (length)^ 

Local  moment  coefficient  per  unit  span 
for  the  J*”  mode 

mJ 

— 

length 

{,Tail}ro0t  8ection  ch°r<*  length. 

rT  ) 

D 

Dt 

— 

1/tirae 

Substantial  derivative; 

D  _  J  .  > 

Dt  it  U  ix 

f j(x,y) 

DEFSL(1,L) 

non- 

j  mode  shape  deflection 

dimensional 

at  location  (X,Y). 

f« 

non- 

til 

Deflection  of  |  lumped  mass 

dimensional 

in  mode  J 

^(x.y) 

DEFSL(2,L) 

1/length 

th 

Slope  of  J  mode  shape  function. 

7>  x 

n,m 

rj 

time 

Scaled  modal  displacement  at 

box  n,m  . 

’  b,  n,m 

7M  .  i  f 

J  u  J 

J 

1/ length 

th 

J  1  mode  shApe  deflection  /  s 

i 

-- - 

mass  x 

Moment  of  inertia  about  the  elastic 
axis  of  the  ith  lumped  mass 

length2 

ij 

— 

force/ 

length 

Generalized  stiffness 

a 

XKS 

Non- 

Reduced  frequency  based  on  leading 

9 

dimensional 

planform  semi-span, 

* 

k  -  OUL 
*«  u 

vii 


NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Oimanaion 

Definition 

kl 

XKI.Kl 

non- 

dimensional 

Reduced  frequency  based  on  the 
chcrdwise  dimension  of  the  Mach  box 

k  - 

1 

kl 

K1BAR 

non- 

dimensional 

kjH2//*  2 

L 

CAFL 

non- 

dimensional 

Vertical  separation  of  the  center 
line*  of  the  2  surfaces,  positive 
upward  measuring  from  the  wing 
to  the  tail. 

n,m 

LJ 

— 

force /length 

lift  on  box  n,m  for  the  Jtk  mode 

m 

LJ 

— 

force /length 

lift  on  the  mth  chordwise  strip 
of  boxes  for  the  jth  mode. 

S 

— 

force/length 

lift  on  a  complete  half-surface 
or  half-airplane  for  the  Jth  mode. 

n,m 

rj 

— 

force/length 

amplitude  of  box  lift  Ljn,ra 

m 

r> 

— 

force /length 

amplitude  of  section  lift  L^m 

rj 

— 

force/length 

aKj^tude  of  total  lift 

»  n,m 

Lj 

BXL1FT 

non- 

dimensional 

Non-dimensional  amplitude  of 
box  lift  (program  output) 
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NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

—  m 

Lj 

SL1FT 

non- 

dimensional 

nondimensional  amplitude  of 
section  lift  (  program  output  ) 
n  -n  iwt  / bl\  -  n 

TL1FT 

non- 

dimensional 

Nondimensional  amplitude  of 
total  lift  (  program  output  ) 

—  |  bi  \  *  i 'ttt’i 

w  -uji1!  • 

i 

EL 

non- 

dimensional 

The  coordinate  location  of  a  pulse 

receiving  point,  i.e.,  the 
perpendicular  distance  from  the 
sending  plane  to  receiving  point. 

M 

XMACH 

-  non-  ■  • 

dimensional 

•  -Mach  number 

MJJ 

— 

mass 

Generalized  mass  for  the  mode 

m 

— 

non- 

dimensional 

The  m  coordinate  location  of  a 

c 

pulse  receiving  point. 

m. 

i 

— 

mass 

I1*1  lumped  mass 

n,m 

N 

xyx 

ENRUS 

ENRLS, 

EN, 

ENSUBD 

non- 

diMensional 

1 

Noraal  wash  at  box  n,m  on  surface 
"xyx"  due  to  local  source  strength, 
where  possible  subscript  values  are; 

x  -.^R-rieht 

\L-left 

y  "(U-upper 
tl-lower 

x  »/W-wing 
VT-tail 

e.g.  NjJy|J  Meant  normal  wash  on  the 
right  upper  wing  at  box  n,m 


ix 


NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

a  n»m 

N 

ENRULU, 

non- 

Normal  wash  at  box  n,m  on  surface 

xyz 

ENRLLL, 

dimensional 

"xyz"  due  to  remote  source  strengths 

abc 

ENRURW, 

ENRULW 

on  surface  "abc",  where  possible 
subscript  values  for  a,b,  and  c 
are  the  same  as  for  x,y,  and  z, 
respectively,  defined  above; 
a  n»m 

e.g.  N  means  normal 

RUT 

LLW 

wash  at  box  n,m  on  the  right  upper 
tail  due  to  source  strengths  on  the 
left  lower  wing. 

N 

NSUBDV 

non- 

No.  of  "sub-boxes"  (chordwise 

s 

dimensional, 
odd  integer 

and  spanwise)  to  be  used  in  the 
subdivision  improvement  technique. 

n 

— 

non- 

dimensional 

the  n  coordinate  location  of  a 
c 

pulse  receiving  point. 

nC*mc» 

— 

— 

Sending  Surface  Coordinate  System 

n  i  ni  }  i 
c  c  c 

— 

— 

Receiving  Point  Coordinate 

System 

p.p(x,y»t) 

— 

force/area 

local  static  pressure 

Pm 

— 

forcc/area 

Free  stream  static  pressure 

Ap(*.y»0 

... 

force/area 

pressure  difference  between  upper 
and  lower  surfaces  at  point  (x,y) 
at  time  t 

4pC*,y,0-p(x,y,t  lM,r-p  <«.».*>, 

x 


NOMENCLATURE 


Mathe¬ 
matical 
:  Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

d  p(x, y) 

-- 

force /are a 

Amplitude  of  pressure  difference; 

a 

4p(x,y,t)  =Ap(x,y)etUJ 

force /length 

Generalized  forg|5  due  to  the  defor¬ 
mation  in  the  i  n  elastic  mode  and 
loading  for  the  modal  deflections 

% 

— 

force /length 

Amplitude  of  generalized  force 

=QiJ 

GENAF 

non- 

dimensional 

Non-dimensional  generalized  force 
(program  output); 

—  iu/t  ks  iuit 

"u’V  ’17»V 

$ 

\) 

CtAGARD 

1/ (length) 2 

Generalized  force  in  the  AGARD 
notation 

/  // 

Qi  J  ■  Sj 

GENAFC 

1/ (length) 2 

Real  and  imaginary  parts  of  Q.  in  the 
AGARD  definition  (program  output) 

q 

— 

force /are a 

dynamic  pressure 

V*> 

length 

Generalized  coordinate  relating  physical 
deflection  to  j*'*1  modal  deflections: 

Z(x,y,t)  =2  fj(x,y)  j(t) 

ij 

— 

length 

Amplitude  of  Jth  generalized  coordinate 

s 

S 

length 

Wing  semi-span. 

rz 


NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

S 

— — 

length^ 

Area  of  integration.  Bounded  by 
edge  of  plan form  plus  diaphragm 
and  lying  inside  the  forward  Mach 
cone  of  the  receiving  point. 

t 

— 

time 

Time 

U 

— 

length/ 

time 

Free  stream  velocity. 

uij51 

— 

non- 

dimensional 

Velocity  spatial  AIC  for  perturbation 
velocity  parallel  to  the  free  stream. 

U 

— 

length/ 

time 

Perturbation  velocity  in  the  stream- 
wise  direction,  positive  downstream. 

V 

non- 

dimensional 

Velocity  spatial  aerodynamic  influence 
coefficient  (AIC)  for  velocity  normal 
to  the  free  stream  and  parallel  to 
the  cending  surface. 

r*y\ 
v  ab" 

V 

non- 

dimensional 

Spatial  AIC  giving  velocity  normal  to 
the  free  stream  and  parallel  to  Bur- 
face  "ab"  at  a  point  on  surface  "xy" 
or  in  the  flowfield  (FF),  due  to  con¬ 
stant  normal  wash  over  a  box  on 
surface  "ab" 

V 

length/ 

time 

Perturbation  velocity  in  the  span- 
wise  direction,  positive  right 
(looking  upstream). 

w 

non- 

dimensional 

Velocity  spatial  aerodynamic  influence 
coefficient  (AIC)  for  velocity  norm-' 
to  the  sending  plane. 

xii 


NOMENCLATURE 


FORTRAN 
Uymbo  L 


W 


Dimension 


Definition 


non-  Spatial  AIC  giving  velocity  normal 

dimensional  to  surface  "ab"  at  a  point  on  sur¬ 

face  "xy"  or  in  the  flow  field  (FF) 
due  to  a  constant  normal  wash  over 
a  box  on  surface  "ab". 


length/  Perturbation  velocity  in  the  vertical 

time  direction,  positive  upward. 


length  Reference  (global)  coordinate  system, 

X  positive  aft,  Y  positive  right, 

Z  positive  upward. 
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NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

X  Y  ,Z 
w’  w  w 

Wing  loc-il  coordinate  system. 

xT.  *T,  zT 

Tail  local  coordinate  system 

^JLE 

XWLE 

length 

The  location  of  a  leading  edge 
definition  point  of  the  wing 
planform,  measured  along  the  X 
co-ordinate. 

XTLE 

XTLE 

length 

Same  as  above  for  the  tail 
planform,  measured  along  the 

X^  coordinate. 

^VJTE 

XWTE 

length 

The  location  of  a  trailing  edge 
definition  point  of  the  wing 
planform. 

Y 

TTE 

XTTE 

length 

Same  as  above  for  the  tall, 
measured  along  the  XT  co-ordinate 

Cl}  ( 

XEDGE  Y 
XCENTR j 

length 

Location  of  the  "j 

\ center  j 

of  a  Mach  box  used  for  the 
placement  of  the  box  pattern, 
measured  along  the  X^  coordinate. 

f  xcwl 
.  XCT 

The  location  of  the  most  upstream 
row  of  boxes  on  thefwing) 
l tall/ 

measured  along  thej'Xw')  co-ordinate. 

l*rj 


xiv 


NOMENCLATURE 


Mathe-  FORTRAN 

matical  Symbol  Dimension  Definition 

Symbol 


Wl.l 

TIJ 


length 


The  location  of  a  leading  edge 
definition  point  of  thefwlng"! 

\tall f 

planform  measured  along 
coordinate  f Yw  | 


y  YBAR 


non-  Offset  of  receiving  chord  from 

dimensional  the  nearest  sending  chord. 


Z  ^ 
u 


L  / 


U,y,t)  — 


(  Upper'! 

length  \  Lower  (Surface  deflection  at 

(x,y)  as  a  function  of  time 


m 

length 

/•T  (x,y) 

— 

length 

sp3  (x,y) 
Ox 

TSLFN 

non- 

dimensional 

~x 

non- 

dimensional 

n,m 

C* 

ALPHA 

non- 

dimensional 

/3 

BETA 

non- 

dimensional 

mesn  surface  deflection: 

^(x.y.O  -  fjfx.yje4^ 

Local  thickness  at  (x,y) 

Local  thickness  slope  at  (x,y) 

Thickness  slope  piston  theory 
correction; 

Z  -  i  +  -J-M  -p* 

Edge  box  area  ratio  for  box(n,m) . 
}j  M2  -  1 
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NOMENCLATURE 


Mathe¬ 

matical 

Symbol 

FORTRAN 

Symbol 

Dimension 

Definition 

bx//3 

BIBETA 

length 

Spanwlse  dimension  of  the 

Mach  box. 

bi  M 

a 

BIBTAS 

length 

Sp inwise  dimension  of  a  sub¬ 
divided  Mach  box. 

v 

GAMMA 

non- 

dimensional 

Ratio  of  specific  heats,  «  1.4 

S 

ZETA 

non- 

dimensional 

Dummy  variable  in  the  Z  or 

w  T 

coordinate. 

5 

ETABAR 

non- 

dimensional 

Dummy  variable  of  integration 

in  the  m  coordinate, 
c 

e 

THETA 

radians 

sin  7^*  “  sin  — - - 

iy-v 

0<i 

radians/ 

length 

Torsion  of  i ^lumped  mass  in 
mode  j. 

A 

— 

non- 

dimensional 

L  coordinate  location  of  a 
c 

pulse  sending  box. 

/ 

MU.YMU 

non- 

dimensional 

tm  coordinate  location  of  a 
c 

pulse  sending  box. 

z1 

YMUBAR 

non- 

dimensional 

m  coordinate  location  of  a 
c 

pulse  sending  box. 

xvi 


NOMENCLATURE 


Mathe-  FORTRAN 

matical  Symbol 

Symbol 


NU.XNU 


XNU8AR 


I  X1 


XIBAR 


t  TAU 


0(x,y,r.)  — 


A0(x,y,t)  — 


Dimension 


Definition 


non- 

dimensional 


non- 

dimensional 


non- 

dimensional 


aon-dim 

dimensional 


Mass/ 

volume 


non- 

dimensional 


length2/ 

time 


length2/ 

time 


n  coordinate  location  of  a 
c 

pulse  sending  box. 


n  coordinate  location  of  a 
c 

pulse  sending  box. 


Dummy  variable  of  integration 

in  the  X  ot  X_  coordinate, 
w  T 


Dummy  variable  of  Integration 

in  the  "n  coordinate, 
c 

Free  stream  density. 


Disturbance  velocity 
at  point  (x,y)  and 
defined  ao  that  5  0 


potential 
time  t, 
is  velocity, 


positive  in  positive  x^  direction, 
where 

x^  ■  X,  Y,  or  Z 


Disturbance  velocity  potential 
difference  between  the  top  and 
bottom  side  of  the  surface  at 
point  (x,y)  and  time  t: 


*0(x.y**) 


0  -  0 

upper 


lower 
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NOMENCLATURE 


Mathe-  FORTRAN 

matical  Symbol 

Symbol 

A  0j(x,y) 


^(x.y)]  DELPHI 


(xTE*y)  1 


A  0, 


TE 


TVP 


l 


(J 


IaJ 


J 


Dimension 


Definition 


length  /  Amplitude  of  velocity  potential 

time  difference  at  point  (jc.y)  or 

for  box  n,m  for  the  J*^  mode 


non- 

dimensional 


Non-dimensional  velocity  potential 
difference  due  to  the  unit  j6*1 
generalized  coordinate  (program  output) ; 


(„jt 

e 


non-  Trailing  edge  velocity  potential 

dimensional  difference. 


degrees  Dihedral  angle  °f(tail}'  radian8» 

positive  upwards  from  horizontal. 


radians/  Circular  frequency 

time 


radians/  Circular  frequency  of  mode  j 

time 


Superscripts 

f  Box  location 

(«y»)  I 

Subscripts 

L  Lower  limit  of  Integration;  Left-hand  surface;  Lower  surface 

R  Right-hand  Surface 

S  Subdivided 

T  Tail 

U  Upper  limit  of  Integration!  Upper  Surface 

W  Wing 

FF  Flowfield 
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GLOSSARY  OF  TERMINOLOGY 


Aftmoat  Box  -  Each  chord  on  each  planform.  and  diaphragm  combination  has 
one  such  box.  It  ia  the  aftmoat  box  on  that  chord  for  which  AIC  arrays 
must  be  calculated  and  may  be  on  the  planform  or  diaphragm. 


AIC  -  Aerodynamic  Influence  Coefficient 


Area  Ratio  -  On-planform  fraction  of  a  box  which  is  cut  by  the  planform 
boundary. 


Apex  Box  -  The  box  on  the  sending  surface  which  encloses  the  apex 
of  the  Mach  hyperbola  associated  with  the  receiving  box. 


Box  Grid  -  Non-dimenslonalized  geometric  array  of  boxes  whose  extent  is 
determined  by  the  geometric  properties  of  the  planforms.  The  term  "grid" 
embraces  the  arrays  on  both  surfaces. 


Control  Point  -  The  location  at  which  a  receiving  box  is  deemed  to  be 
influenced  by  other  boxes.  In  general*  the  center  of  the  receiving  box. 


Effective  Area  -  A  concept  which  relates  entirely  to  the  sub-division 

technique.  It  is  composed  of  those  boxes  sufficiently  close  to  the 

receiving  box  that  their  influence  on  it  is  large  enough  for  the  subdivision 

refinement  to  affect  results  significantly.  The  size  has  been  arbitrarily 

set  to  Include  the  N  /Ne  rows  immediately  ahead  of  the  receiving  box. 
dUa  S 


Global  Co-ordinate  System  -  An  overall  reference  system  of  co-ordinates. 
For  example,  the  airplane  co-ordinate  system  X  ~  aft,  Y aright,  Zr-up. 

Y  *  0  at  centerline  of  airplane. 


Leading  Edge  Diaphragm  -  All  diaphragms  on  which40  »  0. 


Local  Co-ordinate  System  -  A  co-ordinate  system  lying  in  the  plane  of 
the  surface,  x^aft,  y^root  to  right  tip.  y  ■  0  at  center  line  of 
airplane. 


Longitudinal  Separation  -  Streamwise  distance  between  the  trailing  edge 
of  the  wing  and  the  leading  edge  of  the  tall,  measured  along  the  centerline. 
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GLOSSARY  OF  TERMINOLOGY 


Mach  Asymptote  -  The  asymptote  of  the  Mach  hyperbola. 


Mach  Hyperbola  -  The  intersection  of  the  sending  plane  and  the 
forward  Mach  cone  of  the  receiving  point.  Since  this  is  always  non- 
dimenaionalized,  it  is  a  rectangular  hyperbola. 


Map  -  A  condensed  description  of  a  large  amount  of  data  which  can  be 
used  to  locate  any  desired  data  element.  A  map  of  a  banded  sparse  matrix 
might  consist  of  two  numbers  per  row,  the  first  being  the  first  non-zero 
column  of  that  row  and  the  second  being  the  band  width  for  that  row.  The 
matrix  itself  could  then  be  stored  as  band  elements  only. 


Normal  Offset  -  The  lc  distance  between  the  sending  box  and  the  receiving 
point. 

Parallel  Offset  -  The  m  distance  between  the  sending  box  center  and  the 
receiving  point. 


Partial  Box  -  A  sending  box  which  is  cut  by  the  Mach  hyperbola  but  which 
is  neither  an  apex  box  nor  an  edge  box. 


Planar  A.I.C.-  An  A.I.C  defined  by  the  geometric  relation  between  a 
sending  box  and  receiving  box  which  lies  in  the  same  plane,  Cnrr. 
only. 


Receiving  Box  -  In  defining  the  relationship  between  two  boxes  the 
receiving  box  is  the  box  which  can  be  Influenced  by  the  other  box. 


Receiving  Chord  -  Those  receiving  boxes  which  lie  on  the  same  chord. 

The  receiving  chord  is  significant  in  that  all  the  boxes  lying  on  it  use 
AIC  arrays  which  are  a  subset  of  those  for  the  aftmost  box  lying  on  that 
chord. 


Sending  Box  -  In  defining  the  relationship  between  two  boxes,  the  sending 
box  is  the  box  which  influences  the  other  box  (c.f.  Receiving  Box). 


Spatial  A.I.C.  -  An  AIC  defined  by  the  geometrical  relationship  between 
two  boxes  which  do  not  lie  in  the  same  plane.  C^-j,  ,  W-_j  . 
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GLOSSARY  OF  TERMINOLOGY 


Sub-box  -  A  member  of  Ch«  array  of  boxaa  formed  whan  the  grid  of  sending  boxes 
la  subdivided.  Note  It  refers  to  the  small  box  which  is  a  fraction  of  the 
large  box,  and  not  to  a  larga  box  which  has  been  subdivided. 


Tall  -  The  downstream  surface. 

Vertical  Separation  -  The  vertical  distance  between  the  center  lines  of 
the  two  surfaces.  Positive  if  the  second  surface  is  above  the  first. 


Wake  Diaphragm  -  That  part  of  the  diaphragm  where  4P  -  0  due  to 
the  Influence  of  a  surface. 

Wing  -  Upstream  Surface  -  (E.g.  a  Canard  could  be  referred  to  as  a 
wing); 
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Symbol 


X 

Y 

Z 


Transformation 

befinition 

Dimension 

Global  or  Rafaranca  Coordinate  Syatan.  X  positive  Aft, 

Y  positive  Right,  Z  positivi  Upward 

Length 

X  -  WLAX 

Wing  Local  Coordinate  System, 

Ycoa  */  +  (Z  -  WLAZ)sin  * 

used  to  define  wing  leading 

Length 

W  w 

and  trailing  edges.  X_,Y  ,Z 

(Z  -  WLAZ)cos  *w  -  Yain 

ill 

are  similarly  defined  for  the 

tail  local  axes 

<w/bi + 1 

Sending  Surface  Coordinate 

tjoi.it  > +  1/2 

System  used  to  define  box  grid. 

Non-dimen- 

W  1 

The  (n  ,m  )  plane  lies  within 

V<v»> 

c  c 

the  plane  of  the  sending  surface. 

slonsl 

in  this  case  the  right  wing. 

Figure  1  (Cont'd) 


Symbol 

Transformation 

Definition 

Dimension 

n 

i 

9 

IS 

1 

9 

Receiving  Point  Coordinate 

m 

c 

—  (  ) 
c 

System  parallel  to  the 

i 

-(1  -1) 

n  ,m  ,1  coordinates  but 

c 

C 

opposite  in  sign  and  having 

their  origin  at  the  pulse 

receiving  point  (n,a,l  in 

the  n  ,m  ,1  coordinates) 
c  c  c 

non-dimen 

sional 

xxiii 


Figure  2  Coordinate  Syttwm  For  A  Right  Tall 


SYMBOL 

TRANSFORMATION 

DEFINITION 

DIMENSION 

wm 

X-TLAX 

Tall  Looal  Coordinate 

H 

Too.  ||>T4(Z-TLAZ)8in||lT 

Syatea  uaed  to  define 

length 

D 

(Z-TLAZ)ooa  ^-Yain^ 

tall  leading  and 

trailing  adgaa. 

H 

|xt+TLAX-(WLAX4Xc)|  /b^l 

Sending  Surface  Co- 

M 

Y^tyJ  )  *  1/2 

ordinate  Syatea.  Xn 

non- 

thla  caae  the  right 

D 

y(y  0 ) 

tall  la  ahovn  aa 

the  aendlng  aurface. 

diaanalonal 
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SECTION  I 


INTRODUCTION 


Part  II  of  this  report  describes  the  computer  program  written  according  to 
the  analysis  of  Part  I.  Part  II  refers  implicitly  to  Part  I,  Section  III, 
Computer  Program  Usage,  and  material  covered  there  is  not  repeated  here. 

The  program  computes  generalized  unsteady  air  forces  on  a  wing  or  wing  and 
tail  in  supersonic  flow,  given  geometric  details  of  the  surfaces  and  the 
oscillatory  mode  shapes  of  the  surfaces.  The  surfaces  may  be  coplanar,  may 
have  dihedral  angles,  and  may  be  separated  vertically.  The  Mach  box  technique 
may  be  used  "straight",  or  three  refinements  may  be  applied:  1)  Sub¬ 
division  of  the  Mach  boxes  to  improve  velocity  potentials,  2)  Least-squares 
smoothing  of  calculated  velocity  potentials  to  eliminate  roughness  due  to 
box  representation  of  surface  edges,  3)  Piston  theory  correction  for  airfoil 
thickness.  The  refinements  may  be  applied  in  any  combination.  As  inter¬ 
mediate  results,  normal-wasnes ,  velocity  potentials  and  wake  sampling  of 
upwash,  sidewash  and  longitudinal  washes  may  be  printed,  all  at  box  center 
locations.  The  box  lifts,  pressure  distribution,  section  lifts  and  total 
lift  are  also  available  for  each  mode. 
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SECTION  II 


COMPUTER  PROGRAM  DESCRIPTIONS 


GENERAL  DESCRIPTION 

The  computer  program  consists  of  a  main  (0,0)  overlay,  one  primary  level 
overlay,  and  eight  secondary  level  overlays  (see  fig.  (3)).  Ihe  main 
(0,0)  overlay  is  a  general  purpose  driver,  and  easily  can  be  used  to  in¬ 
corporate  other  compatible  programs  with  this  one  as  a  complete  flutter 
system.  Its  sole  function  is  to  set  up  buffers  and  any  other  system 
oriented  parameters,  then  call  the  primary  level  overlay,  CONTROL. 

Overlay  CONTROL  contains  the  basic  logic  of  the  program.  It  first  calls 
secondary  overlay  DATAPP,  which  reads  and  processes  the  basic  card  data 
necessary  for  execution  of  the  program.  The  resulting  parameters  are 
stored  in  labelled  common  blocks,  accessible  to  all  other  overlays. 

If  PRVGEOM  =  .FALSE.,  overlay  GEOMBX  is  next  called.  The  planform 
geometry  is  read  and  processed  to  yield  a  disk  file  IGEOSC  containing 
all  internally  necessary  geometric  parameters. 

If  PRVMODE  =  .FALSE.,  overlay  CONTROL  next  calls  overlay  MODES.  This 
area  processes  the  three  forms  of  modal  data  and  places  the  results, 
evaluated  at  box  centers,  on  scratch  file  MODESC. 

Overlay  CONTROL  next  enters  a  l'op  on  reduced  frequency.  Each  pass 
through  the  loop  first  executes  overlay  VICMAIN,  which  computes  (or  reads 
from  previously  saved  tapes)  all  AIC  arrays  needed  at  the  current  reduced 
frequency.  Next  overlay  NWVPMBX  is  called,  to  compute  normal-washes, 
velocity  potentials,  and  optional  sample  washes.  If  SMOOTH  =  .TRUE, 
overlay  SMTH  is  called  to  do  a  least-squares  surface  fit  of  the  resulting 
Efl  arrays.  If  CRDFIT  =  .TRUE,  overlay  CHORDF  is  called  to  smooth  the 
values  a  chord  at  a  time.  The  final  overlay,  FORCES,  then  computes  box 
lifts,  section  lifts  and  generalized  forces  for  any  smoothed  values 
first,  then  for  the  unsmoothed  values.  The  desired  results  are  printed  as 
they  are  computed.  The  loop  on  reduced  frequencies  terminates  at  this 
point. 

Overlay  CONTROL  reads  the  termination  card  which  causes  a  transfer  back  to 
the  execution  of  DATAPP  (Recycle),  the  call  of  another  overlay  (if 
available),  RETURN  to  the  main  (0,0)  overlay,  or  EXIT  to  control  cards. 

The  following  sections  give  a  more  detailed  description  of  all  of  the 
overlay  main  programs ,  and  the  major  subroutines  called  by  each . 


Program  Overlay  Structure 


GENERAL  PURPOSE  SUBROUTINES 


Fortran  Callable 
Author : 
Purpose: 

Method: 


Usage: 


COMPASS  Function  SHIFT 
G.  E.  Keylon 

To  shift  the  contents  of  a  word  left  or  right  a 
specified  number  of  bits,  identical  to  the  Fortran 
Extended  capability. 

The  word  and  the  number  of  bits  to  be  shifted  are 
stored  in  machine  registers.  The  word  is  then  left 
circular  shifted  the  number  specified.  This  causes 
the  word  to  be  shifted  left  circular  if  the  number  is 
positive  and  right  with  sign  extension  if  the  number 
is  negative.  The  result  is  left  in  register  X6 
so  that  this  routine  must  be  used  as  a  function 
subprogram. 

INTEGER  SHIFT 


IWORD  *  SHIFT  (NWORD.N) 

Input 

NWORD  -  The  word  to  be  shifted 
N  -  The  number  to  shift  the  word 

If  N  is  positive  shift  left  circular. 
If  N  is  negative  shift  right  with  sign 
extension. 

Output 

IWORD  has  the  results  of  the  shift  on  NWORD. 


A 


Fortran  Subprogram  WRTEMX 


Author; 
Purpose : 
Method: 


Usage : 


G.  E.  Keylon 

To  write  a  matrix  on  a  tape  or  disk  file. 

The  matrix  is  placed  row-wise  into  a  buffer  in 
labelled  common  RWBUFF  with  all  of  the  unused  areas 
of  its  array  omitted.  The  buffer  is  then  written 
onto  the  specified  tape  or  disk  file  with  the  Fortran 
BUFFER  OUT  statement.  A  l6  word  header  record  is 
written  in  the  same  manner  before  each  matrix. 

The  header  record  contains  matrix  size,  name  and 
optional  parameters. 

CALL  WRTEMX  (IOUTFL,  MXWRIT,  RANDOU,  NFS,  NMS,  LS,  NMR, 
LWS ,  K,  ID,  A,  I  TYPE,  M,  N,  PARM,  IRR) 

Input 

IOUTFL  -  Tape  number  or  left-justified  file  name. 
MXWRIT  -  Logical  variable,  not  used. 

RANDOU  -  .T.  Random  File  (not  used) 

.F.  Sequential  File 

NFS  -  Number  of  files  to  space  before  writing 
NMS  -  Number  of  matrices  to  space  before  writing 

LS  -  Level  number  to  space  (not  used) 

NMR  -  Name  or  number  in  random  index  (not  used) 
LWS  -  Level  number  of  this  matrix  (not  used) 

K  -  R&w  dimension  of  array  A. 

N.  if  KS  matrix  is  already  in  /RWBUFF/ 

ID  v  Array  containing  matrix  nome. 

A  -  "Array  containing  matrix 

ITYPE  -  TYPExOf  matrix  (i.e.,  real,  complex, 
integer.,  null,  mixed) 

M  -  Row  dimension  of  matrix 

N  -  Column  dimension  of  matrix 

PARM  -  10-word  parameter  arrpy 

Output  s  n 

IRR  -  Error  return  ' ' % 

o,  no  error 

1,  matrix  spacing  is  negative 

2,  File  spacing  is  negative 

4,  M*N  dimensions  greater  than  buffer  size 
1500+1,  encountered  EOF  after  matrix  I 
while  skipping  matrices. 
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Fortran  Subprogram  COMBUF 


Author: 

Purpose: 

Method: 

Usage: 


G.  E.  Keylon 

To  put  a  complex  matrix  into  a  buffer  prior  to 
writing  on  file. 

The  matrix  is  placed  row-wise  into  a  buffer  with  all 
of  the  unused  areas  of  the  matrix  omitted.  All  of 
the  real  parts  are  stored  in  the  first  part  of  the 
buffer  then  all  of  the  imaginary  parts  are  placed 
immediately  following  the  real. 

CALL  COMBUF  (A,  K2,  M,  N,  BUFF) 

Input : 

A  -  Array  that  contains  matrix,  typed  complex 

K2  -  2x  (row  dimension  of  A) 

M  -  Number  of  rows  in  matrix  (not  array  size) 

N  -  Number  of  columns  in  matrix  (not  array  size) 

Output : 

BUFF  -  Buffer  that  will  contain  matrix 


Fortran  Subprogram  READMX 


Author: 
Purpose : 
Method: 

Usage: 


G.  E.  Keylon 

To  read  a  matrix  from  tape  or  disk  file. 

A  l6-word  header  record  and  a  matrix  record  are  read 
from  the  specified  file  with  BUFFERIN  statements. 

The  l6-vord  header  record  contains  matrix  size,  name 
and  optional  parameters.  The  matrix  is  then  placed 
in  a  given  array  in  correct  Fortran  storage. 

CALL  READMX( INFILE,  MXREAD,  RANDIN,  NFS,  NMS,  LS,  NMR, 
K,  NIC,  ID,  ITYPE,  LRS,  A,  M,  N,  PARM,  IRR) 

Input : 

INFILE  -  Tape  number  or  left  Justified  alphanumeric 
file  name 

MXREAD  -  Logical  variable  (not  used) 

RANDIN  -  .T.  Random  File  (not  used) 

.F.  Sequential  File 

NFS  -  Number  of  files  to  space  before  reading 

NM3  -  Number  of  matrices  to  space  before  reading 

LS  -  Level  number  to  space  (not  used) 

NMR  -  Random  name  or  number  (not  used) 

K  -  Row  dimension  of  array  A 

If  K<q  matrix  will  be  left  in  /RWBUFF/ 

NID  -  Number  of  words  available  in  ID  array 

In /Out : 

ID  -  Identification  array 

ITYPE  -  Real,  diagonal,  null,  mixed,  complex 

Output : 

LRS  -  Level  number  of  matrix  read  (not  used) 

A  -  Array  containing  matrix 

M  -  Row  dimension  of  matrix 

N  -  Column  dimension  of  matrix 

PARM  -Array  of  numerical  parameters  stored  with 
the  matrix  in  the  16  word  header  record 
IRR  -  Error  return 
0,  no  error 

1,  matrix  spacing  is  negative 

2,  file  spacing  is  negative 

4,  matrix  dimensions  illegal 

5,  M  ,GT.  K 

1500  +  I,  encountered  EOF  after  matrix  I 
while  skipping  matrices. 


T 


Fortran  Subprogram  CBUFFR 

Author:  G.  E.  Keylon 

Purpose:  To  move  a  complex  matrix  from  a  buffer  to  a  Fortran 

array. 

Method:  The  matrix  assumed  stored  row-wise  in  the  buffer 

with  all  of  the  real  parts  followed  by  all  of  the 
imaginary  parts.  The  conversion  leaves  the  matrix 
in  the  array  in  typical  Fortran  storage. 

Usage:  CALL  CBUFFER(A,K2,M,N,BUFF) 

Input : 

K2  -  2x  (row  dimension  of  array  A) 

M  -  Number  of  rows  in  matrix  (not  array  size) 

N  -  Number  of  columns  in  matrix  (not  array  size) 

BUFF  -  Buffer  that  contains  matrix 

Output : 

A  -  Array  that  will  contain  matrix  in  complex 
storage 
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MAIN  CONTROL  PROGRAM 


Fortran  Program 
Author: 
Purpose: 

Method: 

Usage: 


CONTROL 

G.  E.  Keylon,  G.  D.  Kramer 

To  control  the  flow  of  the  program  to  the  various 
lower  level  overlay  section. 

Ihe  program  has  all  of  the  labeled  common  blocks 
so  that  information  can  be  passed  from  lower  levels 
to  this  program  which  will  determine  the  program  flow 

The  CONTROL  Program  is  a  main  routine.  It  is  the 
only  primary  overlay  section  in  the  program. 

It  calls  •  11  of  the  lower  level  or  secondary  overlay 
sections.  It  is  called  from  the  initial  or  main 
overlay  section  as  follows: 

CALL  OVERLAY (6HAFMB0X,  1,  0,  0) 

Common  Input  and  Output: 

This  program  does  not  input  or  create  common 
values.  It  is  the  means  by  which  common  values 
are  passed  between  the  secondary  overlays  of  the 
program. 


DATA  INPUT  PROCESSOR 


Fortran  Program  DATAPP 

Author:  G.  E.  Keylon 

Purpose:  To  read  most  of  the  input  data  and  set  flags  and 

options  for  use  throughout  the  program.  It  prints 
the  title  and  options  for  each  run. 

Method:  The  title  and  all  the  input  options  are  read  in. 

The  heading  is  printed.  The  options  are  read  under 
a  NAMELIST  format  and  flags  set  to  default  options 
unless  read  in. 

Usage:  The  DATAPP  program  is  the  main  program  of  a  secondary 

overlay  of  the  Mach  Box  program.  It  is  called  as  an 
overlay  section  as  follows: 

CALL  OVERLAY (  gHAFMBOX,  1,  1,  0) 

All  input  and  output  is  through  D.abeled  common  blocks. 


Common  Input: 


PREVEX 

OMACH 

DEFAULT 

Common  Output: 

TITLE 

ERR 

SYM 

PRVGEOM 

XKUAL 

MTYPEW 

PRVMODE 

OPLAIC 

MTYPET 

DIHW 

OSPAIC 

COPLAN 

DIHT 

WTGEOM 

NSUBDV 

XMACH 

NKVALS 

XKI 

XKS 

WTGNAF 

NSURF 

NT5 

WTBL 

SMOOTH 

nt6 

PRBOX 

NDEG 

INTAPE 

PRPAIC 

DPPCPR 

INFSP 

PRSAIC 

ISMPLW 

GEOCPR 

NPLAIC 

PRMODS 

MODCPR 

NSPAIC 

PRCOEF 

PRNW 

AICCPR 

NOUTP 

PRUW 

I0UFSP 

PRSW 

PRVP 

NWSCPR 

OSAIC 

PRBL 

PRSL 

PRGNAF 

PRDCP 

PRGNAC 

GAFCPR 
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GEOMETRY  PROCESSOR 


Fortran  Program 
Author: 
Purpose : 

Method: 


Usage: 


GEOMBX 

G.  D.  Kramer 

To  read  geometric  data  from  cards  and  compute  all 
necessary  geometric  parameters. 

Cards  F  through  L  are  read  in  this  section.  As 
they  are  read  they  are  printed,  then  checked  for 
inconsistent  or  missing  data,  vith  suitable  diag¬ 
nostics.  The  leading  and  trailing  edge  data  is 
checked  in  EDGCHK,  then  transformed  to  non-dimensional 
coordinates,  Planform  and  diaphragm  box  code 
patterns  are  determined  in  BXCDPF  and  BXCDI,  and 
optionally  printed  by  PRNTBC.  Hie  fractional  on- 
planform  portion  of  all  boxes  cut  by  a  planform  edge 
is  determined  by  GMAREA,  which  in  turn  calls  ALPHAC 
and  NTRCEP.  If  spatial  AIC's  are  necessitated  by 
non-zero  dihedral  angles  or  vertical  separation  of 
wing  and  tail,  integer  arrays  MUAIC  are  determined 
for  each  AIC  set  (C,W,V).  These  serve  as  a  map,  so 
that  only  those  AIC  values  needed  will  be  calculated. 
The  MUAIC  arrays  are  computed  in  PVfWAIC  and  PWTAIC. 

All  resulting  arrays  are  written  on  scratch  file 
IGEOSC. 

The  GEOMBX  program  is  the  main  program  of  a  secondary 
overlay.  It  is  called  by: 

CALL  OVERLAY  (6HAFMB0X,  1,  2,  0) 


Common  Input: 


OMACH 

NSUBDV 

TITLE 

NSURF 

PRVGEOM 

MYBW 

DIHW 

PRBOX 

DIHT 

GEO  C  PR 

XMACH 

Common  Output: 

COPLAN 

MXBW 

MXBT 

FSMPLW 

XSUBDV 

MXBBW 

MYBT 

I CHORD 

NSUBDV 

MYBBW 

MYBBT 

IBOXF 

NSUBD2 

MXBSW 

MXBST 

IBOXL 

NSUBCN 

MYBSW 

MYBST 

ZLOC 

B1 

MYBBSW 

MYBBST 

BIBETA 

IXBW 

IXBT 

BIS 

XCENTR 

IXBST 

B1BTAS 

TLAX 

CAPL 
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WLAX  TLA”.  NSPATK 

WLAZ  PS5IT 

PSIW 

Arrays  output  on  scratch  file  IGEOSC: 

IBOXW  -  Wing  box  codes  (Wing  and  tail  if 
COPLAN  =  .TRUE.) 

IBOXT  -  Tail  Box  codes 

FEXLOC  -  Leading  edge  locations  at  chord  centers 
TEXLOC  -  Trailing  edge  locations  at  chord  centers 
ALPHA  -  Fractional  areas  of  boxes  cut  by  a 
plan form  edge 

IJALPH  -  Locations  of  cut  boxes ,  of  the  form 

(iooo*j+i)8 

KPT  -  Table  of  contents  for  the  MUAIC  arrays 
(and  AIC's) 

MUAIC  -  Pointer  array  indicating  where  contri¬ 
buting  boxes  will  be  found  for  one 
spatial  AIC  set. 


Fortran  Subroutine  EDGCHK 


Author:  G. 
Purpose : 

Method: 

Usage: 


D.  Kramer 

Given  the  leading  or  trailing  edge  values,  to  check 
for  illegal  combinations. 

Either  a  leading  or  trailing  edge  is  checked  for 
monotonic  increasing  y-values,  starting  at  zero. 

The  last  trailing  edge  value  is  compared  with  the 
previous  last  value.  A  leading  edge  is  checked  for 
monotonically  increasing  x-values. 

DIMENSION  XEDGE(lO),  YEDGE(lO) 

CALL  EDGCHK  (XEDGE,  YEDGE,  NEDGE,  IEDGE ,  IRR) 

Input  Parameters: 

XEDGE  -  Array  of  X-values  for  edge  location  points 

YEDGE  -  Array  of  Y-values  for  edge  location  points 

NEDGE  -  Number  of  points  to  check 
IEDGE  -  »1,  leading  edge 
=2,  trailing  edge 

Output  Parameter: 

IRR  =0,  Successful 

=  i,  Non-monotonic  y-values 

a  2,  Non-monotonic  x-values,  leading  edge  only 

»  4,  Y-values  not  starting  at  zero 
®  8,  Tip  y-values  not  agreeing 
Other,  additive  combination  of  above 
conditions 
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Fortran  Subroutine  BXCDPF 


Author : 
Purpose : 

Method: 

Usage : 


G.  D.  Kramer 


To  generate  on-planform  box  codes  for  one  surface, 
and  store  them  in  a  compressed  format. 

For  each  (subdivided)  chord,  the  location  of  the 
leading  edge  and  trailing  edge  (FEXLQC,  TEXLOC)  is 
determined.  Codes  for  all  boxes  between  those  values 
are  then  set  to  1  in  subroutine  NCODER.  The  remainder 
of  the  box  code  array  is  not  changed. 

The  subroutine  is  called  by: 

CALL  BXCDPF( XLE ,  YLE,  NLE,  XTE,Y7E,NTE,  LSROWS,  I BOX) 
Input  Parameters: 

XLEl  _  j xi  locations  of  leading  edge,  measured  in 
YLEJ  "  |  yj  nc,  mc>  1^  system 

XTE1  _  locations  of  trailing  edge,  measured 

YTE;  |yj  in  n^,  mc,  1  system 

NtcI  =  i,umber  of  (trail  in  Jfdge  definition  points. 
LSROWS  =  Maximum  number  of  subdivided  rows  allowed. 


In/Out  Parameters: 


IXBW) 

IXBT 


=  Input:  0  indicates  is  to  be  done. 

Output:  Subdivided  row  of  first  unsub¬ 
divided  box  center  on  the  surface. 


Output  Parameters: 

IBOX  Compressed  box  codes,  1  for  on-planform 
boxes  found,  unchanged  elsewhere.  See 
Figure  U. 


Output  Common  Parameters: 


MXBsjJjj 
MYBsg) 
MX2  j?) 


Maximum  X  (aft)  extension  of  the  s fodiviueu 
pattern 

Maximum  Y  (outward)  extension  of  the  sub- 


divided  on -pi an  form 


<wing\ 
}t  ail} 


Maximum  X  extension  of  the  unsubdivided 

ittul  pattern 


It 


TEX3Z)C  array 

i  |  i  i  |  r~r"|-  -i  i  ~p  i 1 

i 

MYBW 


1 - 

Imybsw 


Output  from  BXCDPF,  Calltd  for  a  Wing  (HSUBDV-3) 
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Fortran  Subroutine  BXCDI 


Author: 

Purpose: 


Method: 


Usage: 


G.  D.  Kramer 

Given  an  array  indicating  a  pattern  of  on-planform 
Mach  boxes,  to  determine  the  associated  off-planform 
diaphragm  boxes 

Leading  edge  diaphragm  boxes  are  first  determined, 
followed  by  wake  diaphragm  boxes.  The  tip  diaphragm 
is  then  determined  as  a  function  of  the  tip  chord. 

For  the  wing,  an  integer  array  is  interrogated  to 
determine  whether  additional  wake  areas  (and  tip 
diaphragm)  are  needed  for  wing-tail  interference. 

The  subroutine  is  called  by: 

CALL  BXCDI  (IWAKE,  LSROWS,  LSCHDS,  IBOX) 

Input  Parameters: 

IWAKE:  Array  of  locations  on  the  wing  for  aft-most 

unsubdivided  box  in  each  chord  affecting 
a  tail  surface.  Not  used  for  the  tail 
surface,  first  element  =  0 
LSROWS :  Maximum  number  of  subc* ivided  rows  allowed 
LSCHDS :  Maximum  number  of  subd;  vided  chords  allowed 


Input/Output 

IBOX:  Array  of  subdivided  box  codes,  previously 

set  1  at  planform  locations  by  subroutine 
BXCDPF.  See  figure  5. 


Common  Input 


MXBBSW1 

MXBBSTJ 

IXBST 
MYBSW  \ 
MYBSTJ 


MYBBSW1 

MXBBSTJ 

NSUBDV 


Maximum  X  extension  of  the  subdivided 
box  pattern,  including  diaphragm 
X-location  of  the  first  subdivided  tail  row 

Maximum  Y  extension  of  the  subdivided  plan- 

for°  (Si}  pattern 

Maximum  Y  extension  of  the  subdivided 
pattern,  including  diaphragm  “a'i  ' 

Number  of  subdivisions 


Common  Output 


MYBBSW1 
MYBBST/ 
MYBBW  1 
MYBBT  • 


Modified,  if  necessary 

Maximum  Y  extension  of  the  unsubdivided 

ftai^l  Pattern»  including  diaphragm 


IT 


XBOX  array 


MiBBW  -  7 

|  MYBBSW  -  22 


IXBW  ■  k 


1  1  1\2  / 

111X2^  _ 

111  1\22  ‘ 

1111 iii 

111111  i\  _ _ 

11111111  lTxT" 
1111111111  i>v 
1111111111111 

ill  T  K 

111  (Ones  input) 

1111 


(Leading  Edge  Diaphram) 


111112 
11112  2 
11111222 


Hi 

3  3  3 

111 

111 

W 

111 
111 
1  1  1 

TTT 

l  l  l 
ill 

iii 

iii 

2  2  2 
2  2  2 
2  2  2 

2 

2  2 

2  2  2 

3  3  3 

3  33 

y  j  5 

TTT 

3  3  3 

2(Tip 

2 

2 

3  3  3 

3  3  3 

3  3  3 

3  3  3 

3  3  3 

2  Diaphragm) 

2 

3  3  3 

3  3 

2 

2 

3  3 

(Wake  Diaphragm) 

3 

2  2  2 

2  2 

N3  3 

3  3 

2  2  2 

2 

1  Ni 

3  3  3 

3  3  3 

3  3  3 

3  3  3 

2  2  2 

111 

V  3 

3  3  3 

3  3  3 

3  3  3 

2  2 

111 

1  N3 

3  3  3 

3  3  3 

3  3  3 

2 

111 

Ilf 

SI.  3  3 

3  3  3 

3  3  3 

111 

111 

1\3 

3  3  3 

3  3 

1  1  (Ones 

1  1> 

333 

3 

1  1 

nput) 

111 

1\3  3 

111 

111 

111 

3  ) 

Hi  1 

111 

111 

3  f 

1  1  1 

111 

4— 

LSROWS 


- j 


Figure  5 


Output  from  BXCDI,  called  for  a  Coplan ar  Wing  and 
Tail  (NSUBDV  ■  3) 


Fortran  Subroutine  PRNTBC 


Author : 
Purpose : 

Method: 

Usage: 


G.  D.  Kramer,  G.  E,  Keylon 

Print  the  array  of  box  codes,  either  all  values  or 
only  unsubdivided  box-center  values 

The  compressed  box  code  array  is  decompressed  using 
subroutine  DCODER,  one  row  at  a  time,  and  printed. 

If  unsubdivided  codes  have  been  requested,  only  the 
control  point  values  are  printed. 

CALL  PRNTBC  (IBOX,  LBXCD,  IROW,  MXB,  MYB,  SUBD) 

IBOX  -  Box  code  array 

LBXCD  -  Row  size  of  box  code  array 

IROW  -  First  row  to  print 

MXB  -  Last  row  to  print 

MYB  -  Numoer  of  chords  to  print 

SUBD  -  .T. ,  subdivided  box  codes  desired 

.F. ,  unsubdivided  (control  point)  box  codes 
desired 
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Fortran  Subroutine  PWWAIC 


AUTHOR: 

PURPOSE: 

METHOD: 

USAGE: 


G.  D.  Kramer 

Given  the  box  pattern  and  dihedral  angle  of  the  surface,  to  deter¬ 
mine  a  pointer  array  (MUAIC)  for  one  chord  on  the  right  surface 
which  indicates  contributing  regions  (if  any)  of  the  left  surface 
on  the  given  chord. 

The  geometric  relationship  of  the  sending  surface  to  the  receiving 
chord  is  first  determined.  Then  for  all  rows,  from  the  last  re¬ 
ceiving  box  forward  to  the  forward  edge  of  the  box  pattern,  any 
sending  boxes  on  the  left  surface  are  indicated  in  the  MUAIC  array. 

CALL  PWWAIC ( WING, 1B0X,LBXCD,IWAKE,JC0L) 


Input  Parameters : 

WING  .T.,  wing  is  being  considered. 

.F.,  tail  is  being  considered. 

IBOX  Array  of  box  codes  (IBOXW  or  IBOXT). 

LBXCD  Length  of  array  IBOX. 

IWAKE  Array  of  locations  of  aft-most  box  to  be  considered  on 
the  wing.  Ignored  if  WING  =  .F. 

JCOL  Chord  being  considered  (receiving). 


Common  Innut: 


PS!  {«} 

NSUBDV 

XSUBDV 

NSUBD2 

IXBW 


Dihedral  angle 

Number  of  subdivisions 
Number  of  subdivisions,  real 
NSUBDV /2 

Location  of  first  unsubdivided  box  center. 


Output  Parameters : 

The  computed  results  are  returned  via  common  block  MUAICS.  They 
are: 

SURF  Logical  indicator  -  true  means  a  sending  surface  was  en- 

encountered. 

MUAIC(2,50)  Unsubdivided  row  "map"  of  sending  box  locations, 
see  Figure  7. 

EL  Normal  offset  of  receiving  chord  from  sending  surface. 

YBAR  Parallel  offset  of  receiving  chord. 

NROWS  Number  of  rows  considered. 
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Receiving  box  center  projected 
to  sending  surface  plane 


FIGURE  6, 


FIGURE  7 


<L 


YBAR 


Possible  Arrangement  of  Sending  Boxes.  Left  Surface  to  Right 
(Actual  sending  boxes  shaded.) 


0  0  0  0  3 

2 

2 

2 

2 

3 

5 

7 

9 

11 

13 

0  0  0  0  3 

1+ 

5' 

6 

7 

8 

9 

10 

11 

12 

13 

1 


NROWS  =15 


MUAIC  Array  Generated  by  PWWAIC  for  Figure  U. 


Fortran  Subroutine  PWTAIC 


Author: 

Purpose: 

Method: ] 

Usage: 


G.  b,  K rumor 

Given  the  box  patterns  and  dihedral  angles  of  the  two 
surfaces,  to  determine  pointer  arrays  (MJAIC  arrays) 
for  the  right  wing  and  the  left  wing  contributing 
regions  to  a  desired  tail  chord. 

Hie  geometric  relationship  of  the  sending  surfaces 
to  the  receiving  chord  is  first  determined.  Then  for 
all  rows,  from  the  last  receiving  box  forward  to  the 
forward  edge  of  the  sending  vox  patterns,  any  sending 
boxes  are  indicated  in  the  MUAIC  arrays. 

The  subroutine  is  called,  after  suitable  setup,  by: 

CALL  PWTAIC  ( IBOXW ,  LBXCDW,  IROW,  JCOL,  CAPLL,  YMUVSP) 

Input  Parameters : 


IBOXW  -  Array  of  wing  box  codes 
LBXCDW  -  Row  dimension  of  IBOXW 
IROW  -  Unsubdivided  receiving  row  number 
JCOL  -  Unsubdivided  receiving  chord  number 
CAPLL  -  Vertical  Separation  of  sending  center  line 
receiving  center  line 

YMUVSP  -  Ju.  contribution  due  to  vertical  separation 
=  CAPLL*  sin(tj 

Input  Common  Variables 


PSIDIF 

=  <P~ 

PS  IT 

NSUBDV 

FEXLOC 

PSIW 

TEXLOC 

MYBBW 

MYBSW 

IXBW 

SYM 

Output  Parameters 

The  computed  results  are  returned  via  common  block 
MUAICS.  They  are: 


(SURF  I 


jSURFLj 


=  ,T. ,  Contributing  boxes  were  found  on  U.ft 

PI  «*■« 

,F.,  No  contributions  were  found 
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(MUAIC 
[  MUAICL 


YBAR  \ 

ybarl] 


Map  of  contributing  boxes  on  the 
wing,  see  Figure  7. 

The  normal  offset  between  the  wing 

plane  and  the  receiving  point 


The  paralled  offset  between  the  nearest 


chord  center  on  the  wing 


pattern  and  the  receiving  point 


Number  of  rows  covered  by  the  MUAIC 
array  for  the  J contributions 
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Fortran  Subroutine  GMAREA 


AUTHOR:  G.  E.  Keylon,  G.  D.  Kramer 

PURPOSE:  To  compute  the  fractional  on-planform  portion  of  all  planform  boxes 
which  are  cut  by  a  planform  edge. 

METHOD:  For  each  chord,  the  X  coordinates  of  the  left  side  intercept,  right 

side  intercept,  and  any  kinks  within  the  box  width  are  determined 
by  subroutine  NTRCEP  for  each  planform  edge  cut  by  the  chord  (wing 
and/or  tail).  Then  for  each  planform  box  on  the  chord,  the  routine 
determines  whether  any  edge  cuts  the  box  or  causes  a  contribution  to 
the  box  area.  For  any  affected  box,  subroutine  ALPHAC  is  called 
to  compute  the  fractional  area,  which  is  then  stored  in  array  ALPH, 
and  its  location  is  stored  in  array  IJALPH  as  (J  *  512  +  I) .  The 
fraction  may  be  greater  than  one,  since  it  includes  the  planform 
area  of  any  chordwise  adjacent  box  whose  center  is  off  planform. 

USAGE:  The  routine  is  called  by*. 

CALL  GMAREA  (IBOX,  LBXCD,  WING,  ALPHA,  IJALPH,  NALPH) 

Input  Parameters: 

IBOX  Box  code  array 
LBVCD  Size  of  box  code  array 
WING  .T.,  Wing  or  coplanar  case 
.F.,  Tail 

Input  Common  Parameters: 


COPLAN 

MXBT 

NSURP 

XWLE 

XTLE 

FEXLOC 

MXBW 

NWLE 

YWLE 

YPLE 

TEXLOC 

MYBT 

NWTE 

XWTE 

XTTE 

IXBT 

MYBW 

NTLE 

YVJTE 

XTTE 

IXBW 

NSUBDV 

NTTE 

Output  Parameters: 

ALPHA  Array  of  area  multipliers 

IJALPH  Array  of  corresponding  IJ  locations,  as  (J  *  512  +1) 
NALPH  Number  of  fractions  calculated 
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Fortran  Subroutine  NTRCEP 


AUTHOR :  G.  E.  Keylon 

PURPOSE:  To  compute  the  X  coordinates  of  the  intersections  of  a  planform 
edge  with  the  sides  and  center  of  a  chord. 

METHOD:  The  routine  determines  in  which  interval  of  the  edge  the  desired 

point  lies.  The  x-coordinate  of  the  point  is  then  obtained  from 
the  standard  two  point  equation  of  a  line.  This  is  done  for  all 
three  points. 

USAGE:  The  routine  is  called  by: 

CALL  NTRCEP  (j,  YEDG,  XEDG,  LI,  Cl,  Rl,  NBK1 ,  Kl,  IDEX) 

Input  Parameters: 


J  =  Chord  number 

rax:}'  Arr*ys  °f(x} 


locations  of  the  edge  definition  points 


IDEX  =  1,  leading  edge 
2,  trailing  edge 


Common  Input  Values  (from  local  common  block/LAREA/) 

LEFT  =  Y-location  of  the  left  side  of  the  chord 
RIGHT  =  Y-location  of  the  right  side  of  the  chord 


Output  Parameters 


LI  «  X  coordinate  of  left  side  intersection 
Cl  =  X  coordinate  of  center  line  intersection 
Rl  =  X  coordinate  of  right  side  intersection 


NBK1  =  Number  of  edge  definition  points  encountered  between  the 
left  and  right  sides  of  the  chord. 


Kl  =  0  if  no  edge  definition  point  lies  between  the  left  and  right, 
sides  of  the  chord. 

=  The  first  (leftmost)  edge  definition  point  number  lyitiG 
within  the  chord. 


Subroutine  ALPHAC 


AUTHOR:  G.  E.  Keylon,  G.  D.  Kramer 

PURPOSE:  To  compute  the  on-plani’orm  area  of  a  box  whici.  is  partically  off 
the  planform  or  which  must  include  area  from  neighboring  off- 
planform  box(es)  cut  by  a  planform  edge. 

METHOD:  If  the  box  is  the  first  box  on  the  chord,  or  the  last  box  on  the 

chord,  the  box  is  divided  spanwise  into  a  series  of  trapezoids 
(or  triangles)  determined  by  planform  edge  definition  points  occurring 
within  the  chord.  The  areas  of  these  trapezoids  are  then  added, 
yielding  . 

If  the  box  is  an  interior  box  which  is  cut  by  one  or  more  planform 
edge  segments,  the  area  is  first  set  to  one,  then  the  area  of  the 
off -planform  corner(s)  determined  as  trapezoids  or  triangles  is 
subtracted . 

USAGE:  The  routine  is  called  by 

CALL  ALPHAC  (X,  XLED,  YLED ,  XTED,  7TED,  LI,  Ci ,  HI,  HBK1,  Kl, 

L2,  C2,  R2,  NBK2,  K2,  AREA) 

Input  Paramtern: 


X 

XLED  1 
YLED  ) 


=  X  coordinate  of  box  center 
=  Planform  leading  edge  definition  points 


XTED  ") 
YTED  ) 


=  Planform  trailing  edge  definition  points 


LI  (Left  ] 

Cl  /  =  |  Center »  Chord  edge  intersections  with  the  planform 

R1  /  (Right  /  leading  edge 


NBK1  =  Number  of  planform  leading  edge  definition  points  vis.: 
the  chord 

Kl  =  First  leading  edge  definition  point  within  chord 


Same  as  above  for  trailing  edge 


Output  Value: 


AREA  =  The  desired  box  area,  «t 
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6.  MODAL  DATA  PROCESSOR 


Fortran 
AUTHOR : 
PURPOSE 

METHOD: 


Program  MODES 


G.  E.  Key Ion 

To  read  the  modal  input  data,  compute  it  by  a  least  squares 
surface  fitting  routine  or  evaluate  a  polynomial  equation 
with  coefficients  supplied  by  input  and  store  this  informa¬ 
tion  on  a  scratch  file. 

The  information  needed  to  determine  the  mode  shapes  is  read 
in.  The  planform  information  is  read  from  a  scratch  file 
created  in  the  geometry  section.  The  program  then  computes 
or  reads  the  modal  data  at  control  points,  orders  the  data 
and  writes  the  data  on  a  scratch  file  for  use  in  following 
sections . 


Subroutine  ROPER  is  used  to  compute  row  pointers  for  storing 
box  center  modal  values  row -wise.  Modal  input  from  tape  is 
handled  by  TAPMOD.  If  modal  input  option  2  was  specified, 
FITTER  is  called  to  compute  the  surface  fit  polynomial  coef¬ 
ficients.  PRECOF  is  called  if  the  coefficients  from  option 
1  or  2  are  to  be  printed.  The  coefficients  are  saved  on  a 
scratch  file  for  future  cycles,  and  the  polynomial  is  evaluated 
at  box  centers,  with  the  results  stored  on  scratch  file 
MODESC. 


The  program  also  has  an  option  to  read  an  array  of  Thickness 
slope  function  values  derived  from  "Piston  Theory"  calcula¬ 
tions.  These  values  are  input  to  an  equation  that  computes 
the  thickness  correction  factor. 


ZXU,W*  1 


V  +  I 

■J"  '  ■  • 


M 


2  Zx 

TT 


(i) 


where  ^ 

M 

92/*X 

Input  Methods : 


is  ratio  of  specific  heats  for  a  perfect 
gas  (l.hO) 

is  Mach  number. 

is  the  thickness  slope  function  values, 
is  the  thickness  correction  factor. 


(l)  Polynomial  Coefficient  Input 

The  degree  of  u  surface  polynomial  equation  and  the 
coefficients  ure  read  in.  The  deflection  la  then  com¬ 
puted  by  the  following  polynomial  equation: 


27 


Oil  lection 


a\  Atye*s 

(*,*V  +  ~..+  .oixV) 


l«l 


(2) 


where,  point  (X,Y)  is  the  coordinates  of  a  box  center 
in  the  planform  local  coordinate  system,  and  a  is  the 
array  of  polynomial  coefficients  read  in.  The  slope  is 
computed  by  taking  the  derivative  of  the  deflection  in 
the  X  direction. 
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These  equations  are  used  to  compute  the  deflection  and 
slopes  for  all  the  planform  boxes .  The  array  of  modal 
values  is  stored  on  a  scratch  file  for  use  in  the  vel¬ 
ocity  potential  and  generalized  forces  sections  of  the 
program . 


(3) 


(2)  Interpolation 

The  degree  of  a  surface  polynomial  equation,  the  number 
of  locations  where  deflections  are  to  be  given  and  the 
locations  and  deflections  sure  read  in.  The  deflections 
are  perpendicular  to  the  surface  and  the  (X,Y)  locations 
are  input  in  the  planform  local  coordinate  system.  The 
program  uses  this  data  to  fit  a  surface  polynomial  ex¬ 
pression  in  the  least  squares  error  approximation.  The 
routine  that  performs  the  surface  fit  is  subroutine  TIT¬ 
TER.  This  routine  sets  up  an  upper' triangular,  aug¬ 
mented  matrix  that  represents  the  set  of  simultaneous 
linear  equations  formed  by  taking  the  partial  deriva¬ 
tives  of  each  deviation  equation  squared  and  setting 
it  to  zero.  It  then  solves  the  set  of  simultaneous 
linear  equations  by  using  the  Choleski  square  root 
method  given  in  Reference  1.  The  solution  is  an  array 
of  polynomial  coefficients  that  are  used  to  compute  the 
modal  values  in  the  same  manner  as  method  (1). 
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USAGE: 


w— 


( 3)  Modal  Values  at  Box  Centers 

The  values  of  the  deflections  and  slopes  are  read  in 
from  cards  or  tape  and  stored  on  a  scratch  file  for  use 
in  the  velocity  potential  and  generalized  forces  sec¬ 
tions  of  the  program.  The  values  are  stored  in  order  of 
boxes  within  chord,  and  chords  within  planform.  The 
order  is  fore  to  aft  boxes,  center  most  to  tip  chord  and 
wing  before  tail.  For  card  input,  each  chord  begins  on 
a  new  card.  All  of  the  mode  shape  for  the  wing  will  be 
read  followed  by  all  of  the  mode  shapes  for  the  tail. 

The  MODES  program  is  the  main  program  of  a  secondary  overlay 
of  the  Mach  Box  program.  It  is  called  as  follows: 

CALL  OVERLAY  (6HAFMB0X,  1,  3,  0) 

Input : 

Uses  labeled  common  blocks: 

/PROBLM/ 

/GEOMTY/ 

/GE0M2/ 

/FILES/ 

/I0C0NT/ 

/TAPEIO/ 

/MODES/ 

/RWBUFF/ 

Uses  the  following  files: 

IGEOSC 

Output : 

Output  is  stored  on  file: 

MODESC 


t 
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Fortran  Subprogram  KOPEK 
AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  compute  the  row  pointers  indicating  location  of  planform  boxes. 

METHOD:  The  subprogram  uses  the  column  pointers  and  determines  the  row 

pointers.  The  subprogram  will  also  calculate  pointers  for  a 
tail  surface  with  overlapped  planform  and  store  the  pointers  after 
the  first  planform  pointers. 

USAGE:  CALL  ROPER 

General  labeled  common  blocks  used: 

/geomty/ 

/GE0M2/ 

LOCAL  labeled  common  blocks  used: 

/INDEX/  IS(100),  NOC(lOO) ,  JS(50),  J0C(50) 

Common  Input: 

IS(J)  -  The  ith  index  of  the  first  planform  oox  on  chord  J. 

NOC(J)  -  The  number  of  planform  boxes  on  chord  J. 

Common  Output: 

JS( I)  -  The  jth  Index  of  the  first  planform  box  on  row  1. 

JOC(l)  -  The  number  of  planform  boxes  on  row  J. 
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Fortran  Subprogram  FITTER 


AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  fit  a  surface  in  the  least  squares  sense  through  a  net  of  data 
points. 

METHOD:  The  fitter  routine  is  passed  a  set  of  ordered  triplets  and  the 

degree  of  polynomial  to  fit.  It  is  also  given  a  scale  factor  if 
needed  to  scale  the  data  to  prevent  the  occurrence  of  arithmetic 
overflow  or  underflow.  The  program  can  fit  real  or  complex  data. 
The  system  of  simultaneous  linear  equations  that  must  be  solved 
for  employs  the  Choleski  square  root  method  (see  Ref.  l).  If 
the  polynomial  exceeds  the  maximum  capability  in  either  X  or  Y 
direction  that  degree  is  held  and  the  other  direction  is  allowed 
to  use  the  full  degree. 

USAGE:  CALL  FITTER  (M,  N,  X,  Y,  Z,  C,  CN,  IDIM) 


Input: 


M  -  degree  of  polynomial  equation 
N  -  number  of  data  points  to  fit  curve  through 
X  -  Array  of  X  coordinates 

Y  -  Array  of  Y  coordinates 

Z  -  Array  of  Z  coordinates 

CN  -  scale  factor 

IDIM  -  Indicator  of  real  or  complex  function 
=  1,  function  to  fit  is  real 

function  to  fit  is  complex 


Output : 


-  Output  polynomial  coefficient  array. 
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Fortran  Subprogram  MODOUT 


AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  print  the  mode  shapes  in  a  manner  that  the  user  can  readily 
determine  Mach  box  values  of  deflections  and  slopes. 

METHOD:  The  mode  shapes  are  rearranged  in  a  print  array  so  that  one  row  or 

part  of  a  row  will  be  printed  at  a  time.  If  there  are  more  than 
15  chords  on  the  planform  the  program  prints  information  for  15 
chords,  for  all  rows,  and  then  prints  for  the  next  15  chords  until 
all  information  has  been  printed.  The  values  may  be  scaled  before 
printing  to  allow  values  to  be  printed  under  F  mode  Fortran  format 
control.  The  scaling  factor  will  be  indicated  in  the  title. 

USAGE:  CALL  MODOUT  (DEFSL,  JS,  JOC,  NROWS,  NM,  IOVLAP) 

Input: 


DEFSL  -  Array  of  mode  shapes 

DEFSL(l,l)  *  deflection 
DEFSL(2,I)  «  slope 

JS  -  Array  of  pointers  to  first  planform  box  on  each  row 

JOC  -  Array  of  counters  for  the  number  of  planform  boxes  on 

each  row. 

NROWS  -  number  of  rows 

NM  -  Mode  shape  number 

IOVLAP  -  Number  of  boxes  of  overlap  between  planforms  fo:  non- 
coplanar  surfaces. 

Output: 

None 
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Fortran  Subprogram  PRECOF 
AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  print  the  polynomial  coefficients  used  in  evaluating  mode  shapes 

METHOD:  The  coefficients  are  printed  with  each  coefficient  having  over  it 

the  corresponding  powers  of  X  and  Y  labeled.  All  the  coefficients 
for  a  total  power  will  on  one  line  (l.e.,  line  1  -  0  power ,  line  2 
first  power,  line  3  -  second  power  etc.). 

USAGE:  CALL  PRECOF( IDEG,  A,  EFR) 

Input: 

Labeled  common  block  /FILES/ 

IDEG  -  Degree  of  polynomial  equation 
A  -  Array  of  coefficients 

IFR  -  Flag  indicating  how  coefficients  are  obtained. 

=  1,  read  from  cards 

u  2,  computed  by  least  squares  surface  fit. 

Output : 

None 
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7.  AERODYNAMIC  INFLUENCE  COEFFICIENTS  SECTION 
Fortran  Program  VICMAIN 
AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  determine  all  aerodynamics  influence  coefficients  (AIC's)  that 
must  be  computed  or  retrieved  for  a  specified  reduced  frequency. 

METHOD:  A  parameter  array  is  read  from  the  geometry  scratch  file  for  each 

spatial  AIC  that  is  needed.  The  program  then  determines  if  an 
array  already  exists  on  permanent  tape  storage.  If  it  exists  the 
array  is  read  in,  expanded  if  necessary,  and  stored  on  scratch 
file  IAICSC  if  spatial,  or  in  blank  common  if  planar.  If  calculation 
is  necessary,  subroutine  KERNEL  is  called  to  control  the  actual 
computations.  KERNEL  in  turn  calls  ROMBER  to  do  the  integrations 
of  FUNCT  and  VFUNC. 

USAGE:  The  VICMAIN  program  is  the  main  program  of  a  secondary  overlay  of 

the  Mach  Box  program.  It  is  called  as  follows: 

CALL  OVERLAY  (6HAFMB0X  1,  4,  0) 

Input: 

Uses  labeled  common  blocks 

/kern/ 

/kval/ 

/problm/ 

/files/ 

/geomty/ 

/iocont/ 

/arrays/ 

/rwbuff/ 

/tapeio/ 

Uses  the  following  files 

IGEOSC ,  OSPAIC  (optional),  OPLAIC  (optional) 

Output: 

Output  is  stored  on  files: 

NPLAIC,  NSPAIC ,  IAICSC  (all  optional) 
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Fortran  Subprogram  KERNEL 


AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  determine  the  boxes  to  be  integrated  and  the  limits  of  inte¬ 

gration  prior  to  calling  the  integration  routine. 

METHOD:  The  program  determines  from  a  parameter  array  from  the  geometry 

scratch  file,  the  intersection  of  the  Mach  cone  with  the  planform 
boxes  it  is  attempting  to  integrate.  It  determines  what  boxes  on 
a  row  are  to  be  integrated  and  breaks  each  box  up  into  a  set  of 
integrable  limits.  It  then  passes  the  limits  of  integration  to 
subroutine  ROMBER  for  integration  by  the  Romberg  integration 
method  described  in  Reference  2. 


Box  Patterns  and  Limits: 


One  region  to 
integrate 


FIGURE  8  AIC  Integration ,  Full  Box 


Limit  2 
Limit  1 


Z 


Limit  3 
Limit  2 
Limit  1 


One  region  to 
integrate 


Two  regions  to 
integrate 


Limit  3 
Limit  2 
Limit  1 


Two  regions  to 
integrate 


FIGURE  9  AIC  Integration  Edge  Boxes 
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Limit  3 
Limit  2 
Limit  1 


One  region  to 
integrate 


Two  regions  to 
integrate 


T.-imit.  !) 

1  Limit  3 

I— Limit  2 
Ximit  1 


Three  regions  to 
integrate 


FIGURE  10  AIC  Integration  Apex  Boxes 


Box  patterns  and  limits  for  boxes  cut  on  the  left  side  by  the 
Mach  hyperbola  are  computed  in  a  like  manner. 

The  functions  integrated  by  subroutine  ROMBER  are  those  for  the 
velocity  potential  aerodynamic  influence  coefficients  ), 

the  upwash  aerodynamic  influence  coefficients  ),  and  the 

sidewash  aerodynamic  influence  coefficients  (Vp^l). 


The  equations  for  and  are: 


L 

'  7 r 


{  Jc  (~M~  /M  ,iin' 


The  equations  is  valid  for  all  types  of  boxes,  which  are 

shown  in  Figures  8,  9,  and  10,  The  equation,  as  written,  is 

valid  for  the  region  of  an  apex  box  shown  in  Figure  l'O,  that  has 
the  hyperbola  as  a  boundary  on  both  sides.  The  last  term  is  zero 
for  regions  that  have  the  hyperbola  as  a  boundary  for  one  side 
and  the  box  edge  as  the  other  side  boundary.  The  last  term  and 
the  terms  evaluated  at  the  integration  limits  are  zero  for  full 
boxes  or  regions  bounded  on  both  sides  by  the  box  edges.  The 
values  of  the  integrand  used  in  ROMBSR  are  computed  by  subroutine 
FUNCT  which  also  calls  subroutines  RANGE  and  BESSEL  to  evaluate 
the  Bessel  functions. 

The  function  is  considerably  different  and  holds  for  all 

regions  to  be  integrated.  The  evaluation  of  the  integral  is  done 
by  subroutine  VFUNC.  The  equation  is: 
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Fortran  Subprogram  ROMBER 

AUTHOR:  C.  E.  Keylon 

PURPOSE:  7c  integrate  the  aerodynamic  influence  coefficient  functions. 

METHOD :  The  program  uses  the  Romberg  integration  technique  (Ref.  2). 

The  technique  is  a  modified  trapezoidal  area  method  with  an  extrap¬ 
olation  method  added.  For  analytical  cases  the  sidewash  aerodynamic 
influence  coefficient  will  be  solved  by  an  analytic  equation,  not 
by  numerical  approximation. 

USAGE:  CALL  ROMBER  (XILL,  XILU,  IUC ,  ERR,  IFLAG,  KlBAR,  YMJBAR,  EL,  XMACH 

C,  W,  V) 


Input: 

XILL  -  Lower  limit  of  integration 
XILU  -  Upper  limit  of  integration 

IUC  -  Flag  indicating  type  of  box  or  edge  condition  of  interval 
to  be  integrated  =  0,  full  box 

1,  left  side  of  box  is  edge  of  Mach  hyperbola. 

2,  right  side  of  box  is  edge  of  Mach  hyperbola. 

3,  both  sides  of  box  are  edges  of  Mach  hyperbola. 


ERR  -  Convergence  criteria  (relative,  not  absolute) 
IFLAG  -  Indicator  of  real  or  imaginary  parts 
=  0,  real  part 
=  1,  imaginary  part 

KlBAR  -  Function  of  reduced  frequency  and  Mach  number, 


(M2  -  1) 


YMUBAR  -  Parallel  offset  of  pulse  sending  box. 

EL  -  Normal  offset  of  receiving  point  from  sending  plane. 


XMACH  -  Mach  number 


Output: 

C  -  Velocity  potential  aerodynamics  influence  coefficient, 

W  -  Upwash  aerodynamic  influence  coefficient, 

V  -  Sidewash  aerodynamic  influence  coefficient, 
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Fortran  Subprogram  RJNCT 
AUTHOR:  G.  E.  Keylon 

RIRPOSE:  To  evaluate  the  velocity  potential  and  upwash  aerodynamic  influence 
coefficient  functions  for  a  set  of  independent  variables. 

METHOD:  An  array  XI  of  independent  variables  is  passed  to  the  program  throng! 

the  calling  sequence.  The  program  evaluates  the  function  at  each 
point  first  checking  for  boundary  conditions  where  the  function 
approaches  a  singularity.  Routines  to  find  the  range  of  and  value 
of  Bessel  functions  are  called  in  the  evaluation  of  the  function. 

USAGE:  CALL  FUNCT  (K,  XI,  FXIC,  FXIW,  IFLAG,  K1BAR,  EL,  YMUBAR,  IUC,  XMACH, 

BESSY) 

Input: 

K  -  Number  of  functions  to  evaluate 
XI  -  Array  of  independent  variables 
IFLAG  -  Indicator  of  real  or  imaginary  parts 
=  0,  real  part 
=  1,  imaginary  part 

K1BAR  -  Function  of  reduced  frequency  and  Mach  number,  K.M' /(!•*/-! ) 
EL  -  Normal  offset  of  receiving  point  from  sending  plane. 

YMUBAR  -  Parallel  offset  of  pulse  sending  box. 

IUC  -  Flag  indicating  type  of  box  or  edge  condition  of  interval 
to  be  integrated. 

XMACH  -  Mach  number 

Output : 

FXIC  -  Function  values  for  Velocity  Potential  AIC. 

FXIW  -  Function  values  for  Upwash  AIC . 

BESSY  -  Evaluation  at  end  points  for  upwash  AIC . 
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Fortran  Subprogram  BESSEL 
AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  evaluate  the  Bessel  functions  for  a  given  argument  over  a  range 

of  orders. 

METHOD:  The  argument  and  range  (#  of  terms  or  order)  is  passed  to  the  the 

routine.  The  routine  then  calculates  the  required  terms  and  places 
them  in  an  array  and  returns. 

USAGE:  CALL  BESSEL  (K12,  AV,  NA) 

Input: 

K12  -  The  argument,  a  function  of  independent  variable,  Mach 

number  and  reduced  frequency. 

NA  -  Highest  order  of  the  Bessel  function  to  be  evaluated. 
Output: 


AV 


Array  containing  the  Bessel  functions 


Fortran  Subprogram  RANGE 


AUTHOR:  G.  E.  Keylon 

PURPOSE:  To  determine  the  range  (or  order)  of  a  Bessel  function  with  a 

given  argument. 

METHOD:  An  order,  or  equation  for  an  order,  is  given  for  various  increments 

of  arguments.  This  routine  determines  which  interval  the  argument 
ic  in  and  computes  the  order. 

USAGE:  CALL  RANGE  (K12,  NA) 


Input: 


K12  -  The  argument,  function  of  independent  variable,  Mach  number 

and  reduced  frequency-. 


Output: 

NA  -  Highest  order  of  the  Bessel  function  to  be  evaluated. 
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Fortran  Subprogram  VFUNC 


AUTHOR:  G.  E.  Keylon 


PURPOSE:  To  evaluate  the  sidewash  aerodynamic  influence  coefficient  function 

for  a  set  of  independent  variables. 

METHOD:  An  array  of  independent  variables  is  passed  to  the  program  through 

ti.  '  calling  sequence.  The  program  evaluates  the  function  at  each 
point,  first  checking  for  boundary  conditions  where  the  function 
approaches  a  singularity. 

USAGE:  CALL  VFUNC  (K,  XI,  FXIV,  IFLAG,  K1RAR,  EL,  YMJBAR,  INC,  XMACH,  IND,  VT) 


Input : 

K  -  Number  of  values  to  calculate 

XI  -  Array  of  independent  variables 
IFLAG  -  Flag  indicating  real  or  complex  part 
=  0,  real  part 

=  1,  imaginary  part  _  p 

K1BAR  -  Function  of  reduced  frequency  and  Mach  number,  K^MT /(m  -l) 
EL  -  Normal  offset  of  receiving  box  above  sending  plane. 

YMUBAR  -  Parallel  offset  of  pulse  sending  box. 

INC  -  Flag  indicating  type  of  box  c.r  edge  .condition  of  interval 

to  be  integrated. 

XMACH  -  Mach  number 

IND  -  Indicator  to  calculate  VT  terms 

=  0,  do  not  calculate 
=  1,  calculate 

Output: 

FXIV  -  Function  values  for  oidevash  AIC. 

VT  -  Extra  terras  calculated  at  the  limitB  of  integration. 
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8.  NORMAL-WASHES  AND  VELOCITY  POTENTIALS 
Fortran  Program  NWVLPT 
AUTHOR:  G.  D.  Kramer 

PURPOSE:  To  compute  normal  veches  and  associated  velocity  potentials  for  each 
oscillatory  mode  shape  at  box  centers.  Wake  sampling  of  upvash, 
sidevash  and  longitudinal  vash  is  also  provided. 

METHOD:  The  necessary  box  patterns  and  other  geometric  items  are  first 

read  in  from  the  scratch  file  IGEOSC .  The  mode  shape  and  velocity 
potential  pointer  array  IPNTRM  is  read  from  scratch  file  MODESC, 
and  a  pointer  array  for  normal -washes,  IPNTDW,  is  generated  by 
subroutine  POINTR.  These  pointer  arrayo  serve  to  associate  a  box 
location  in  a  sparsely  filled  rectangular  array  with  the  corres¬ 
ponding  mode,  velocity  potential  or  normal  wash  value  in  a  singly 
dimensioned,  densely  filled  array. 

A  loop  on  mode  shapes  is  entered  next.  The  box  center  deflections 
and  shapes  are  read  from  MODESC  into  array  DEFSL.  Subroutine 
VELPOT  is  called  for  the  wing  to  compute  N*„w  ,  ,  W  *>$ 

at  box  centers,  and  trailing  edge  6$  values  in  array  TVP.  If  a 
tail  is  being  analyzed  as  veil,  the  contributing  wing  normal -washes 
are  determined  and  VELPOT  is  called’ again.  Optional  printing  of 
WRUW'  etc*  and  is  done  in  routing  PRINTR. 

If  sampling  of  wake  washes  is  desired,  subroutine  SMPLW  is  called 
to  compute  and  print  these  results. 

The  array  VELPOT  and  the  TVP  array  are  written  on  scratch  file 
IVPSC  for  each  mode  shape. 

USAGE:  The  DWVLPT  program  is  the  main  program  of  a  secondary  overlay  of 

the  Mach  box  program.  It  is  called  as  follows: 

CALL  OVERLAY  (6HAFMB0X,  1,  5,  0) 

Input:  Uses  labelled  common  blocks 

/contrl/  /files/ 

/problm/  /iocont/ 

/geomty/  /tapeio/ 

/GE0M2/  /MODES/ 

/kern/  /arrays/ 

/kval/  /samplw/ 

Uses  scratch  files 

IGEOSC 

IMODESC 
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Fortran  Subroutine  POINTR 


AUTHOR:  G.  E.  Keylon,  G.  D.  Kramer 

PURPOSE:  To  generate  part  or  all  of  a  pointer  array  which  indexes  another 
array  of  box  associated  values  (modes,  normal-washes,  etc.) 
stored  compactly,  rw-wise. 

METHOD:  The  box  codes  are  scanned  to  determine  the  first  box  of  interest 

and  the  number  of  boxes  of  interest  on  each  row.  From  this,  the 
pointer  array  is  generated  such  that  IPNTR(l,i)  «  the  location  of 
the  first  box  value  for  row  i,  and  IPNTR  (2,  i)  =  the  chord  number 
of  the  first  box  value  for  row  i. 

USAGE:  The  routine  is  called  by: 

DIMENSION  IBOX  (LBXCD,  #  chords/lO),  IPNTR  (2,  MXIR) 

LOGICAL  DIAFH,  SUBD,  WING 

CALL  POINTR  (IX,  MX,  MYB,  IOVLAP,  SUBD,  DIAFH,  IBOX,  LBXCD,  MXIR, 
IPOINT,  IPNTIN,  IPNTR) 

Input  Parameters: 

IX  =  First  row  of  the  box  pattern  for  which  the  pointer  array 
is  desired. 

MX  =  Number  of  rows  desired. 

MYB  *  Maximum  row  length 

IOVLAP  =  Number  of  rows  to  allow  for  overlap  ( tail  only) . 

SUBD  =  .T.,  a  pointer  array  for  subdivided  boxes  is  desired 

=  .F.,  only  unsubdivided  box  information  is  desired. 

DIAFH  =  .T.,  boxes  in  diaphragm  areas  are  to  be  Included. 

=  .F.,  only  on-planform  boxes  are  of  interest  though  space 
may  be  left  within  a  row  if  imbedded  diaphragm  areas  occur. 
IBOX  =  Array  of  subdivided  box  codes  generated  in  the  geometry 
section . 

LBXCD  =  Length  of  box  code  array. 

MXIR  =  Length  of  IPNTR  array,  used  to  control  end-around  buildup 
of  the  array. 

IPOINT  =  Value  to  be  used  for  first  pointer;  1  if  IX =1,  else  the 

next  location  available  in  the  array  "pointed  to"  for  row  IX. 

In/out  Parameters: 

IPNTIN  =  Location  of  next  available  cell  in  the  IPNTR  array.  This 
will  be  incremented  for  each  row  processed  until  MXIR  is 
reached,  when  it  is  reset  to  1. 

IPNTR  (2,  MXIR)  =  The  pointer  array,  see  Method  above. 
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FOTu-KAN  Subroutine  GETAIC 


Author : 
Purpose: 

Method; 

Usage: 


G.  D.  Kramer 


To  get  the  desired  Aerodynamic  Influence  Coefficient 
(AIC)  arrays  from  scratch  file  IAICSC. 

From  the  calling  sequence,  the  location  of  the  desired 
AIC  array(s)  is  determined.  If  they  are  in  core, 
the  routine  returns.  If  there  are  none,  the  error 
flag  is  set.  Otherwise,  the  disk  file  is  positioned, 
and  the  desired  arrays  are  read  into  local  common 
block  AICS. 

EL,  YBAR,  NR0W3,  MUAIC  (2,50)  are  in  a  common  block, 
MUAICS  for  output  from  GETAIC 

NWWAIC,  NTT AIC,  NRWTAIC,  NLWTAIC  and  PAIC  (4,50)  are 
in  a  common  block  /PAICS/,  for  use  by  the  routine. 

CALL  GETAIC  (JUCENT,  ITYPE ,  ICODE,  IR) 

Input  Parameters : 

JUCENT  =  receiving  chord  number 

ITPE  =  1,  2,  3,  ^  indicating  wing-wing,  tail-tail, 
right-wing-tail,  or  left-wing-tail  AIC's 
desired 

ICODE  =  0,  C,V,W  desired 

1,  V,W  desired 

2,  V  desired 


Common  Input: 


NWWK  ' 
NTTK 
NRWTK 
NLWTK 


)  =  Number  of  AIC  arrays  avail¬ 
able  for  influence. 


rwing-wing 
tail-tail 
right  wing-tail 
. left  wi ng-tail 


PAIC  ( 4 ,50 )  =  Table  of  contents  for  the  AIC's. 

PAIC  (l,j)  indicates  where  the  AIC's 
for  the  Ith  form  of  influence  ( see 
above)  on  the  Jth  chord  are  located. 


Output  Parameters: 

IR  =  D,  Success 

1 ,  C  not  found 

2,  C  and  W  not  found 

3,  Nothing  found 

Common  Output: 

C  =  C - 

W  =  W--- 

V  =  v-iJ- 

VJJW 
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Fortran  Subroutine  VELPOT 


(5)  Velocity  potentials: 


Because  the  equations  involve  summations  over  unknown  values,  the 
order  of  calculation  is  very  critical.  The  routine  computes  nor¬ 
mal  washes  and  velocity  potentials  in  parallel,  one  row  at  a 
time,  inboard-most  box  first.  If  the  subdivision  option  is  on, 
each  subdivided  box  must  have  a  set  of  normal  washes  computed  as 
well,  using  equations  similar  to  those  above. 


For  each  box,  the  N  terms  are  first  zeroed  out.  If  spatial  con¬ 
tribution  is  present,  subroutine  GETAIC  is  called  to  get  the 
necessary  AIC  arrays  from  scratch  file  IAICSC,  and  the  proper 
summation  is  computed  over  the  forward  Mach  hyperbola.  This  is 


first  done  for  S, 
ENRLLL . 


RUS 

LUS 


and  N_t  _  and  stored  in  variables  ENRULU, 
nLo 

LLS 


If  the  surface  is  a  tail,  a  similar  procedure  of  getting  AIC 
arrays  and  computing  the  proper  summation  for  and  Np^,  is 

RW  LW 

followed.  The  results  are  stored  in  ENRURW  and  ENRULW. 


If  the  box  being  considered  is  a  planform  box,  the  normal  wash 
values  are  next  computed  from  Equations  (9)  or  (l6). 

Function  B  is  called  to  compute  the  planar^?  contribution,  ex¬ 
cept  for  the  contribution  of  the  box  to  itself.  This  is  stored 
in  variable  DELPH.  If  the  box  is  on  planform,  the  out-of-plane 
contribution  is  added,  yielding  Equation  (l9)-»  If  the  box  is  on 
a  diaphragm,  DELPH  is  used  in  Equation  (12)  or  (13)  to  eventually 
yield  the  normal  wash  values  at  the  diaphragm  box  center. 


Trailing  edge  velocity  potentials,  array  TVP,  are  computed  when¬ 
ever  a  trailing  edge  box  is  encountered.  The  computation  is  nor¬ 
mally  linear  extrapolation  from  the  last  two  box  center  values. 

In  the  event  there  is  only  one  box  on  the  tip  chord,  a  Mach  ray 
extrapolation  is  first  done,  followed  by  chord-wise  linear  in¬ 
terpolation.  See  Figure  11. 


h9 


Values  at  A  and  B  are  ex= 
trapolated  to  C.  Then  the 
values  at  C  and  D  are  inter¬ 
polated  to  give  a  value  at  E, 
the  desired  trailing  edge  value. 


FIGURE  11  Tip  Chord  Trailing  Edge  Velocity  Potential  Calculation 


The  subdivision  option  causes  the  following: 


(1)  All  row  and  column  loops  are  on  subdivided  boxes. 

(2)  Any  necessary  terms  are  calculated  once  per  control  point, 
and  stored  in  temporary  arrays  for  use  on  all  subdivided 
boxes  within  the  unsubdivided  box.  N  terms  and  spatial  con¬ 
tribution  of  left  surface  to  A  p  are  not  calculated  using 
subdivided  values. 

(3)  Function  B  and  Ap  are  not  computed  for  on-planform  subdi¬ 
vided  boxes  which  do  not  contain  a  control  point. 

(M  Function  B,  when  called,  applies  two  equations  -  one  witnin 
the  "effective  area"  of  subdivision,  and  the  other  outside 
this  area.  It  is  within  function  B  that  the  subdivision  re¬ 
finement  actually  takes  place. 

(5)  Any  unsubdivided  box  which  has  one  or  more  off-planform  sub¬ 
divided  boxes  has  its  normal  wash  values  computed  as  t-.e 
average  of  all  subdivided  values  within  its  bounds,  i.e. 


t>0 


JSAGE: 


The  subroutine  is  called  by: 

CALL  VELPOT ( I BOX , LBXCD , PKERNL , SKERNL ,WING,DIHS) 


Input  Parameters: 

IBOX  Array  of  box  codes  for  the  surface. 
LBXCD  Length  of  the  box  code  array. 

PKERNL  Primary  (unsubdivided)  Cp-0  array. 

/*s 


SKERNL 

WING 

DIHS 


Subdivided  C ^ 0  array. 

.TRUE.,  the  surface  is  a  wing. 
.FALSE.,  the  surface  is  a  tail. 


.TRUE.,  any  surface  dihedral  is  to  be  accounted  for. 
.FALSE.,  any  surface  dihedral  may  be  ignored. 


Input  Common  Variables : 
Global  common  blocks  used: 

/  }::omty/ 

■'GE0M2/ 

/MODES/ 

/FILES/ 

/ CKECKPR/ 

Blank  Common  for  C 


Local  common  values: 


/MUA1CS/YBAR  Parallel  offset 

EL  Normal  offset 

MUAIC(2 ,50)  AIC  pointer  array  determined  in  the  geometry 

section. 

NROWS  Number  of  rows  defined  for  the  AIC  set. 


/ AICS/  XKVL 
C 


Current  value  of  K^ 
C 


W 


W 


V 


V 


/DELTAP//TEXL0C7 

(FEXLOCJ 

IPNTRM 

DEFSL 

IOVLAP 

/NW ASHES/  IPNTDW 
/BXCDES/  IBOXW 


{.trailing^  e<ige  ^-loca't^ons  chord  centers 

Pointer  array  for  modes  and  velocity  potentials. 
Mode  shape  array  -  equivalenced  to  velocity 
potential  array. 

Measure  of  tail  overlap  of  wing,  box  mode  shapes. 
Pointer  array  for  normal  wash  values. 


Wing  box  codes 


Output  Common  Variables: 


/DELTAP/ 

DELPHI 

A  P  array 

TVP 

A  $T£  &rT&v 

/NWASHES/ 

ENRUS 

!Iruw  or  nrut 

ENRLS 

nrlw  or  nrlt 

IOVLAPH 

Measure  of  tail  overlap  of  wing  diaphragm, 
for  normal  washes . 

/SHWASK/ 

IPNTSD 

Pointer  array  for  subdivided  normal  washes 

ENSUBD 

"bus  “d  “bls 

IPNTIN 
IPNTOT  l 
IPNTLS j 

|  End-around  pointers  for  array  IPNTSol 

5£ 
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Fortran  Function  B 


AUTHOR: 
PURPOSE : 

METHOj.: 


G.  D.  Kramer 

Given  the  location  of  a  Mach  box,  to  compute  the  planar  contribu¬ 
tion  of  the  rest  of  the  surface  to  the  velocity  potential  differ¬ 
ence  for  the  box. 

The  routine  has  two  sections,  one  for  computing  the  subdivided 
contribution  within  the  "effective  area,"  and  the  other  to  com¬ 
pute  the  unsubdivided  contribution  from  ahead  of  the  "effective 
area".  If  the  subdivision  option  is  off,  the  second  section  is 
used  for  the  full  contribution. 

In  the  first  section,  the  summation  performed  is 


Iz 


where  the  summation  limits  are  as  shown  in  Figure  12. 


(21) 


mAY/Mmv/A 
mmmj’AO. 
OM'/SAY/. 

vsm. 


Effective 

Area 


Always  contributes  to  the  summation 
loci  Contributes  if  the  dihedral  angled  =  0 

FIGURE  12  Subdivided  "Effective  Area" 
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The  second  section  starts  up  where  the  first  leaves  off,  and  com¬ 
putes  the  second  summation  in  Equation  (22) 


where  the  suoimation  limits  are  as  shown  in  Figure  13  and  the  AIC 
array  and  normal  wash  values  are  now  unsubdiv idea ,  computed  at 
control  points. 


FIGURE  13,  Unsubdivided  Boxes  Outside  the  "Effective  Area" 


USAGE: 


The  function  is  called  by: 

DELPH  =  B( 1R0W ,  JCOL ,PKERNL,SKERNL ,IBOX,LBXCD ,WING ,DIH ) 

Input  Parameters: 

Location  of  receiving  point,  subdivided 

Primary  (unsubdivided)  array 

/n,  s’ 

Subdivided  C  —  *  array 

Box  code  array 

Length  of  box/ code  array 

.TRUE.,  the  surface  is  the  wing 

.FALSE.,  the  surface  is  the  tail 

.TRUE.,  leftside  is  to  be  ignored 

•FALSE.,  Include  left  side. 

Input  Coupon  Parameters: 

See  subroutine  VELPOT.  Both  subdivided  and  unsubdivided  values 
are  used. 

Output : 

The  function  value,  B,  in  this  case  stored  in  DELPH,  is  the  re¬ 
sult  of  the  summations  described  under  METHOD. 


IROV) 

JCOL/ 

PKERNL 

SKERNL 

IBOX 

LBXCD 

MING 

DIH 
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Fortran  Subroutine  SMPLW 


AUTHOR : 
PURPOSE: 

METHOD: 


G.  D.  Kramer 

To  compute  and  print  upvashes ,  sidewashes ,  and  longitudinal  washes 
at  arbitrary  chord  locations  in  the  wake  of  a  wing. 

This  routine  is  called  once  for  each  sampling  chord.  For  each 
box  on  the  chord,  the  right  wing  contribution  is  summed  as 


WSUM  = 

T. 

KA 

*•  N 

RW 

(23) 

rt.  wiHj 

VSUM  = 

21 

^  RW 

(2h) 

rt  winj 

PHISUM 

=  ^  ^  t'/U 

A  N  RW 

(25- 

where  NRW  =JnRIjW  the  chord  is  above  the  wing, 
if  the  chord  is  below  the  wing. 

These  sums  are  then  combined  as: 

UWR  =  “lT*  (Vbt  )*  (cos  ^  * WSUM  + sin  ^  VSUm)  (26) 

SWR  =  — "j“*  e  ^  l/b^fcos  Tw  *VSUM~Sin  WSUM^  (27) 

PHId  =  PHISUM 

n 

The  left  wing  contributing  summations  are  identical  to  Equation:: 

(23),  (2U),  and  (25),  with  NRW  replaced  by  NJjW. 

The  results  are  then  combined  by 

"Wrt.  ’  UWR  +  (fA)  *  (C0S  t  *WS«M-.in^/^SUM)*SYM 

SW  =  SWD  +  f  Vb  W  f  COS  VS'UM-sinV'K,*WSUM')*SYM 

complete  R  \  '  t  /  \  "  • 
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9.  VELOCITY  POTENTIAL  SMOOTHING  SECTIONS 
FORTRAN  Program  SMTH 

Author:  G.  E.  Keylon 

Purpose:  To  smooth  the  velocity  potentials  by  using  a  least 

squares  surface  fitting  technique. 

Method:  The  velocity  potentials  are  read  in  from  a  disk  file 

and  smoothed  with  a  least  squares  fit  by  subroutine 
FITTER,  previously  described.  The  polynomial 
equation  derived  from  the  fit  is  then  used  to  compute 
an  array  of  velocity  potentials  at  planform  box 
centers . 

Usage:  The  SMTH  program  is  the  main  program  of  a  secondary 

overlay  of  the  Mach  box  program.  It  is  called  as 
follows : 

CALL  OVERLAY  (6HAFMB0X,  1,  6,  0) 

Input : 

USES  LABELLED  COMMON  BLOCKS 

/ARRAYS/ 

/FILES/ 

/IOCONT/ 

/PROBLM/ 

/KVAL/ 

/GEOHTY/ 

/ GEOM2/ 

/TAPE 10/ 

/KWBUFF/ 

Uses  the  following  files 
MODESC,  I GEOS C,  IVPSC 

Output : 

Output  is  stored  on  file  IWTFSC  which  is  changed 
to  IVPSC. 


58 


FORTRAN  Program  CRDFIT 


Author : 
Purpose: 

Method: 

Usage: 


G.  E.  Keylon 

To  smooth  the  velocity  potentials  by  using  a 
least  squares  curve  fit  along  each  chord. 

The  velocity  potentials  are  read  in  from  a  disk 
file.  The  values  for  each  chord  are  then  separated 
into  an  array.  The  values  are  then  changed  to  the 
numerical  slope  between  the  midpoint  average  values. 
Subroutine  CURVE  is  then  called  to  fit  a  least  squares 
polynomial  curve  though  these  slopes.  The  polynomial 
equation  is  then  integrated  at  each  box  on  the  chord 
and  the  integral  value  becomes  the  velocity  potential 
at  that  box. 

The  CRDFIT  program  is  the  main  program  of  a  secondary 
overlay  of  the  Mach  box  program.  It  is  called  as 
follows : 

CALL  OVERLAY  (6HAFMB0X,  1,  7,  0) 

Input : 

USES  LABELED  COMMON  BLOCKS 

/ARRAYS/ 

/FILES  / 

/IOCONT/ 

/PROBLM/ 

/KVAL  / 

/GEOMTY/ 

/GE0M2  / 

/TAPEIO/ 

/RWBUFF/ 

Uses  the  following  files 
MODESC,  IGEOSC,  IVPSC 

Output: 

Output  is  stored  on  file  IWTFSC  which  is  changed 
to  IVPSC. 
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FORTRAN  Subprogram  CURVE 


Author:  G.  E.  Keylon 

Purpose:  To  fit  a  curve  in  the  least  squares  sense  through 

a  set  of  data  points. 

Method:  The  CURVE  routine  is  passed  a  set  of  ordered  complex 

pairs  and  the  degree  of  polynomial  to  fit.  The 
system  of  simu^  ’"->ous  linear  equations  is  solved 
employing  the  Choleski  square  root  method  (see 
Ref.  1).  If  the  polynomial  degree  exceeds  the  limits 
possible  to  fit  the  degree  is  reduced  to  a  lower 
level. 

Usage:  CALL  CURVE  (M,N,X,Z,C) 

Input : 

M  -  degree  of  polynomial  equation 
N  -  number  of  data  points  to  fit  curve  through 
X  -  Array  of  X  coordinates  (independent  variable) 
Z  -  Array  of  Z  coordinates  (dependent  variable, 
complex) 

Output : 

C  -  output  polynomial  coefficient  array,  complex 


10.  GENERALIZED  AIR  FORCES  SECTION 


Fortran 

AUTHOR: 

PURPOSE 

METHOD : 


Program  FORCES 


0.  K.  Keylon,  G.  D.  Kramer 


To  calculate  the  boxlifts,  section  lifts,  and  generalized  air 
forces  for  a  problem. 

Planform  information  is  first  read  from  the  geometry  and  modes 
scratch  files.  The  outer-most  loop  on  thickness  slope  functions 
is  then  entered.  One  set  of  thickness  slope  functions,  defined 
at  box  centers  by  Equation  (l),  is  read  in  from  scratch  file 
ITSLSC.  Next  a  loop  on  mode  shapes,  used  as  weighting  functions 
for  the  generalized  forces  calculations,  is  entered.  One  mode 
shape  is  read  from  scratch  file  MODESC. 

The  third  loop  entered  is  on  velocity  potentials.  The  array 
is  read  into  DELPHI  and  #TE  into  array  TVP  from  scratch  file 
IVPSC.  The  box  pattern  for  each  surface  is  then  passed  over,  one 


row  at  a  time.  For  each  box  the  following  values  are  computed: 

TE  -  LE  +  ICC  kt  Jzt 


=  m  .  ,  2 

=  BX  LIFT  (|  DC)  =  — 


J 


A Cfj.  =DELCP{I  DC)  =  1-  /(«■  *  bi) 


(3.') 

(33) 


*  "'*>  6/  - 


■  r  nr.  1  *  n 

L“  k,  f  ]  zT 


rvj 


The  Q.j  1/2  terms  are  summed  as  calculated,  and  stored  as 

afrow(jvp)  -  ^  y 

trt  n  1 )  ' 


(3>t) 


(3S) 


After  all  boxes  have  been  processed,  if  boxlifts  and  section  lifts 
are  desired  and  this  is  the  first  mode  shape,  box  lifts  are 
printed,  section  lifts  are  computed  and  printed,  and  total  lift 
is  printed: 


SB  M 

Li 


~  SUFT(JCOL) 


y  a  run 

*  l—  Li 

W  * 


f.  -TUFT 

J 


-  E 


m 


(36) 

( <n 
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After  this  has  been  done  for  all  velocity  potentials,  one  row  of 
the  final  generalized  air  forces  arrays  is  computed  as: 


q,  =GENAF<|J)=  2//3  AFROW(JVp) 


-“'fa  Ri  tOy] 


(38) 

(39) 

(UO) 


The  program  does  the  above  for  all  mode  shapes ,  prints  the  results , 
optionally  writes  them  on  tape,  then  terminates.  Printing  is  done 
in  routines  PRNTBL,  PRNTSL,  and  PRNTAF. 

For  Equations  (32)  and  (3*0  box  leading  and  trailing  edge  values 
are  needed.  Several  geometric  conditions  exist: 


(l)  Box  leading  or  trailing  edge  is  internal  to  the  planform: 
Linear  interpolation  is  used, 

f  r>n1  -  1  t  r  n~1>  ™ 

He  -  2  {  ] 


(LI) 


AK7  -  +  ^ntn) 

and  similarly  for  the  box  trailing  edge. 


(2)  Box  is  cut  by  the  planform  leading  edge: 

HI* 1  ,  \  Df 

fL£  *  f  -(*»-XuKt 


(L2) 


(point-slope)  (hi) 


0  for  wing  or  spatial  tail 


Win 
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(3)  Box  is  cut  by  the  planform  trailing  edge 


Computed  planform  trailing  edge  value,  TVP,  as  des¬ 
cribed  under  subroutine  VELPOT.  This  normally  is  a 
linear  extrapolation  using  the  forward  adjacent  box 
center  and  the  current  one  for  the  two  necessary  a  ? 
values . 


USAGE:  The  FORCES  program  is  the  main  program  of  a  secondary  level  over¬ 

lay  of  the  Mach  Box  program.  It  is  called  as  follows: 

CALL  OVERLAY  (  6HAFMB0X,  1,  7,  0) 

Input : 

L'.  s  labeled  common  blocks: 

/ARRAYS/ 

/FILES/ 

/IOCONT/ 

/KERN/ 

/KVAL/ 

/PROBLM/ 

/MODES/ 

/GEOMTY/ 

/GE0M2/ 

/TAPEIO/ 

/RWBUFF/ 

Uses  the  following  files: 

MODESC 

IPNTRM 

IVPSC 

ITSLSC 

Output : 

Printer  and  tape  NOUTP  ( optioned). 
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11.  COMMON  BLOCK  ORGANIZATION 


The  basic  geometric  and  program  control  parameters  are  stored  in  a 
set  of  labeled  common  blocks  which  are  loaded  with  the  primary  level 
overlay  and  thus  are  available  to  any  secondary  overlay.  Some  of  the 
variables  come  directly  from  card  input  values  (see  Part  I,  Section 
III  of  this  report),  and  others  are  internally  computed. 

Default 


/CONTRL/  PREVEX,  OMACH,  TITLE (8) ,  PRVGEOM,  PRVMODE , 

DIHW,  DIHT,  DEFAULT 

PREVEX  Tested  for  code  word  in  the  data  preprocessor 
link  to  determine  whether  defaults  should  be  set  or 
prior  status  maintained  (recycle) 

OMACH  Mach  it  from  previous  cycle,  compared  on  recycle 
to  determine  whether  planform  geometry  needs  changing. 
TITLE(8)  One-line  title  for  all  printed  headings 
PRVGEOM  .T.  previous  geometry  is  to  be  used  this  cycle 
.F.  New  geometry  is  to  be  read 
PRVMODE  .T.  previous  modes  are  to  be  used  this  cycle 
•F.  new  modes  are  to  be  read 

DIHW)  .T.  dihedral  is  to  be  used  computing 

DIHTJ  3  '  influence  on  itself 

•  F.  T'ie[tail}  is  t0  considered  flat  in 

computing  influence  on  itself,  but  dihedral 
will  be  used  in  wing/ tail  calculations 
DEFAULT  .T.  All  parameters  on  Card  C  are  to  be  set 
to  their  default  values 
.F.  Do  not  set  parameters  to  default. 


0. 


blank 

.F. 


.F. 


.F. 


.F. 


/PROBLM/  XMACH, 
EXAIC, 


NMODES,  NTSLOP ,  NKVALS ,  SMOOTH,  NDEG,  CRDFIT , 
SUBDV,  PLYWOOD 


XMACH  *  Mach  number  for  current  cycle 
NMODES  *  Number  of  input  modes  to  use 
NTSLOP  *  Number  of  thickness  slope  functions  to  be 
used 

NKVALS  »  Number  of  reduced  frequencies  to  be  used 
SMOOTH  »  ,T. ,  Velocity  potentials  surface  smoothing 
desired 

.F.,  No  velocity  potential  surface  smoothing 
desired 

NDEG  =  Maximum  order  for  smoothing  polynomial 

CRDFIT  =  .T.,  Chordwise  velocity  potential  smoothing 
desired 

.F.,  No  chordwise  smoothing  desired 
EXAIC  =  .T.,  Integration  accuracy  of  10"^  desired 
.F.,  Integration  accuracy  of  10“2  desired 
SUBDV  =  ,T. ,  Subdivision  is  to  be  applied 
.F.,  No  subdivision  is  desired 
PLYWOOD  -  .T.,  Full  box  areas  to  be  usea  in  box  lifts 
,F.,  Planform  box  areas  to  be  used. 


no  default 
no  default 
0 

0 


.F. 


0,  program  wl ) . 
determine 


.F. 


■  F. 


.F. 
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Derault 


/GEOMTY/  CO PLAN,  NSUBDV,  XSUBDV,  NSUBD2,  NSUBCN,  NSURF , 

Bl,  BIBETA,  BIS,  B1BTAS ,  WLAX,  WLAZ,  PSIW,  MXBW,  MXBBW, 
MYBW,  MYBBW,  MXBSW,  MYBSW,  MYBBSW,  IXBW,  XCENTR 

/GE0M2/  TLAX,  TLAZ,  PSIT,  MXBT,  MYBT,  MYBBT,  MXBST, 

MYBST,  MYBBST ,  IXBT,  IXBST,  CAPL 

COPLAN  .T.  PSIW  =  PSIT  and  CAPL  =  0.  One  box  array 
is  used 

.F.  The  2  surfaces  are  not  coplanar,  or  only 
one  surface  is  defined 

NSUBDV  Number  of  subdivided  rows  (columns)  per  box 
XSUBDV  =  Float  (NSUBDV) 

NSUBD2  =  NSU3DV/2 

NSUBCN  =  NSUBD2  +  1  =  center  location  of  first  chord 
NSURF  Number  of  surfaces,  1  or  2 

Bl  Box  length  =  I  iBETA  *  V  M*  -1 

BIBETA  b  /0,  box  width,  =  YWLE(NWLE)/MYBW 


BIS  ) 
BIBTASj 


Subdivided  box 


i  length  =  Bl/XSUBDV  1 
[width  =  B1BETA/XSUBDV  j 


xl  /Tail!  local  61x13  l°cati°n,  in  global  X  co- 
J  ordinate 

Z]  /Tail!  local  61x13  location,  in  global  Z  co- 
1  '  ordinate 

r|  JTaili  <111:ie<lral  angle  >  input  in  degrees  but 
'  ■*  immediately  changed  to  radians. 


Number  of  rows  to  aftmost  portion  of 

measured  in  the  n  coordinate 
c 


HE?} 


MXBBW  Number  of  rows  to  aftmost  wing  diaphragm 


box,  n  coordinate 
c 

Number  of  chords  on  the 


MYBBW 

MYBBT 

MXBSW 

MXBST, 


|  Number  of  chords  on  the  ,  in,  c 

Number  ofr*”®|  chords,  including  tip 
3  diaphragm ■ * 

Subdivided  MXB  count 


m  coordinate 
c 


*NCHRDS? 
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Default 


/KERN/  ERR,  MXSKRN,  IPKERN,  NPLKRN,  NSPATK,  NR0WEA 

ERR  Integration  accuracy  in  AIC  calculations  .01 

MXSKRN  Size  of  the  subdivided  AIC,  array  (number  of  rows) 

IPKERN  Location  in  array  SKERNL  where  PKERNL(l)  ] 

would  be  if  it  were  not  overlaid  by  the 
subdivided  array. 

NPLKRN  Size  of  the  planar  AIC  array  (number  of  rows) 

NSPATK  Number  of  spatial  AIC  arrays  necessary  0 

NRflWEA  Number  of  rows  for  the  subdivided  effective  area 
/KVAL/  IKVAL ,  XKVAL(20),  XKS  (20) 

IKVAL  Current  k-value  number  being  solved 
XKVAL  Array  of  reduced  frequencies,  k, ,  based  on 

I  1 

box  length,  bq 

XKS  Array  of  reduced  frequencies,  kg,  based  on 
semispan,  s. 

/FILES/  NT5,  NT6,  INTAPE,  INFSP,  NPLAIC,  NSPAIC,  IIOUTP, 

IO’JFSP ,  MODES C,  IVPSC,  IGEOSC,  IWTFSC,  IAICSC 

:iT5  Card  file  (INPUT) 

NT6  Print  file  (OUTPUT)  (> 

INTAPE  binary  input  tape  number.  If  0  or  card  0 

input  will  be  used 
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Default 


INFSP 

NPLAIC 

NSPAIC 

NOUTP 

IOUFSP 

MODESC , 
IGEOSC, 
IAICSC 


Initial  file  spacing  on  the  input  tape 


Tape  number  for  the 


( planar  7 
\  spatialj 


AIC  arrays 


Binary  output  tape  number.  If  0,  none  written 
Initial  file  spacing  on  tape  NOUTP 

IVPSC  } 

IWTFSC  >  Internal  scratch  files 


/ IOCONT/ 


OPLAIC 

OSPAICj 


OPLAIC,  OSPAIC, 

WTGEOM,  WTGNAF,  WTSLs  WTBL,  PRBOX,  PRPAIC, 
PRSAIC ,  PRMODS ,  PRCOEP,  PRUW,  PRSW,  PRVP,  PRHL, 
PRDCP ,  PRGNAF,  PRGNAC,  PRSL,  PRLW,  PRNW- 

.T.  ,  an  old  f^^tiall  use<^ 

,F. ,  a  new  1  AIC  tape  is  being  used 


WTGEOM  Not  used 


WTGNAF 


PRBOX 

PRPAIC-) 
PRSAIC i 


.T.  ,  Write  generalized  air  forces  on  tape 

.T.  ,  Write  section  lifts  on  tape 

.T.  ,  Write  box  lifts  on  tape 

•T. ,  Print  the  box  code  pattern(s) 

.T.  ,  Print  the  AIC  arrays 


PRMODS  .T. ,  Print  modal  deflections  and  slopes 


PRCOEF 


PRDCP 


PRGNAF 


PRGNAC 


•T. ,  Print  modal  polynomial  coefficients,  if 
available 

upwashes 

.T. ,  for  wake  wash  sampling,  print  7side  washes  ] 

longitudinal 
washes  / 

.T,,  Print  velocity  potential  differences 
.T. ,  Print  box  lifts,  Lj,m 

.T. ,  Print  change  in  pressure,  A  Ca,m 

.T.,  Print  generalized  airforces,  Q. . 

i  j 

.T, ,  Print  generalized  aerodynamic  coefficients, 
Q'  and  Q" 

•T.  Print  sectional  generalized  airforces, 
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Default 


PRSL  .T. ,  Print  section  lifts, 

J 

PRiT.;  .T.  ,  Print  normal  washes,  NR(jW,  N  ,  etc. 

/TAPEIO/  NFS,  NIC,  LS,  NMR,  ID(20),  HID,  I TYPE,  LRS , 
LWS,  2-5,  H,  PARM(IO),  IRR 
DIMENSION  IPARM(IO) 

EQUIVALENCE  (PARM,  IPARM) 

NFS)  ("File  ~) 

Hie/  (Matrix)  Spacing 

\  N°t  used 

NMR  j 

ID  ID  array  for  the  matrix 

NID  Number  of  words  in  the  ID  array  on  tape 

I TYPE  Matrix  type  -  MIXED,  COMPLEX 

Not  used 

Matrix  dimensions 

PARM  Numerical  parameters  for  the  matrix 

IRR  Error  return 


/MODES/  SYM,  SYMT,  MTYPEW,  MTYPET 

SYM  1,  Symmetric  modes  1 

-1,  Antisymmetric  modes 
0,  Left  surface  contribution  will  be  ignored 
SYMT  As  above,  for  a  non-planar  tail.  Differs  SYM 

only  for  vertical  tail 

MTYPEW  1,  Polynomial  coefficients  will  be  read  2 

for  the  wing 

2,  Deflections  at  arbitrary  locations  will 
be  read 

3,  Box  center  values  will  be  read 

MTYPET  1,  Same  as  above  for  the  tail 

2,  2 
3, 


/ARRAYS/  KBXCDW ,  LBXCDW,  LBOXC,  KBXCDT,  LBXCDT,  KJALPH, 
LJALPH,  KALPHA,  KKERNL,  LKERNL ,  KPNTRM,  LPNTRM,  KDEFSL, 
KELPHI,  LMODES ,  KPNTSD ,  LPNTSD,  KSDW,  LSDW,  KPNTDW , 
LPNTDW ,  KDW,  LDW,  KTVP,  LTVP 
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Variable 


Value 


ICBXCDW 

LBXCDW 

LBOXC 


Array  affected 
IBOXW  (LBXCDW,  LBOXC) 


Not  used 


150 

8 


KBXCDT 

LBXCDT 

KJALPH 

LJALPH 


1 

I 


IBOXT  ( LBXCDT ,  LBOXC) 


IJALPH  (LJALPH) 


(  Not  used 
l  90 


{Not  used 
200 


KALPHA 


ALPHA  (LJALPH) 


KKERNL 

LKERNL 


SKERNL  (LKERNL),  PKERNL 


Not  used 


{ 


1 

i64o 


KPNTRM  | 
LPNTRM  j 

KDEFSL 


KELPHI 

LMODES 

KPNTSD 

LPNTSD 


IPNTRM  (2,  LPNTRM) 

DEFSL  (2,  MODES ) 

DELPHI  (  LMODES),  complex 


IPNTSD  (2,  LPNTSD) 


KSDW 

LSDW 

KPNTDW 

LPNTDW 

KDW  * 
LDW  J 

KTVP 
LTVP 


) 


ENSUBD  (2,  LSDW) 

IPNTDW  (2,  LPNTDW) 

ENRUS  (LDW),  ENRLS  (LDW) 

TVP  (LTVP),  TEXLOC  (LTVP), 
FEXLQC  (LTVP  ) 


{ 

{ 

{ 

{ 

{ 

{ 


Not  used 
100 

Not  used 

Sot  used 
500 

Not  used 
50 

Not  used 
600 

Not  used 
100 

No  used 
1275 

Not  used 
250 


De  fuu  LI. 


/RWBUFF/  BFCODE,  IBFCNT,  BUFF  (3280) 

BFCODE  =  Code  word  { 

IBFCNT  =  Size  of  buffer 

BUFF  =  Buffer  array  for  use  by  READMX  and  WRTEMX 

/SAMPLW/  ISMPLW,  ICHORD(lO),  IBOXF(lO),  IBOXL(lO) ,  ZLOC(lO) 
ISMPLW  Number  of  chords  specified  for  wash  sampling 
ICHORD  Chord  number  for  sampling 
IBOXF  First  box  on  chord  to  be  sampled 
IBOXL  Last  box  on  chord  to  be  sampled 
ZLOC  Z-location  of  sampling  chord,  transformed 

internally  to  correspond  to  wing  coordinates 


8HBUFFSIZE 

3280 


/PLANXY/ 


NWLE,  NWTE,  NTLE,  NTTE,  XWLE(lO),  YWLE(lO), 
XWTE(IO) ,  YWTE(lO),  XTLE(lO),  YTLE(lO) , 
XTTE(IO),  YTTE(10) 

Number  of  wing  {^aninV'efge]  definiti°n 

points 

Humber  of  tail  definition 

points 


trailing  edge] 


Wing  leading  edge  definition  points 


Wing  trailing  edge  definition  points 
Tail  leading  edge  definition  points 


Tail  trailing  edge  definition  points 


COMMON/  CHECKPR/  DPPCPR,  GEOCPR,  AICCPR,  NWSCPR, 

SMCPR ,  GAFCPR 

These  variables  are  all  typed  logical.  They  control  whether 
or  not  internal  checkout  print  statements  will  be 
executed.  They  will  be  read  from  Card  C,  default  .FALSE. 

DPPCPR  Data  preprocessor  check-print 
GEOCPR  Geometry  check-print 
AICCPR  AIC  section  check-print 

NWSCPR  Normal  wash  &  velocity  potential  check-print 
SMCPR  Velocity  potential  smoothing  check-print 
GAFCPR  Generalized  Airforces  check-print 
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2 .  ARRAY  STORAGE 


In  order  to  conserve  storage,  a  number  of  arrays  are  used  as  pointers  for 
sparse  arrays.  All  unusual  array  usage  is  described  below. 


a.  Arrays  Generated  in  the  Geometry  Section 


IBOXW  -  Subdivided  box  pattern 
for  first  planfora,  or  both  if 
"coplanar" 


IBOXT  -  Subdivided  box  pattern 
for  2nd  planform,  if  non- 
"coplanar" 


1XBST 

XXBT 


MXBST 


MYBBST, 


Mr 

-a«r 

i 

i  i 

ill 

ill 

i 

ill 

1 

ill 

ill 

ill 

ill 

ill 

ill 

i  i 

ill 

ill 

ill 

ill 

ill 

ill 

i  i 
i 

FIGURE  14.  Box  Code  Arrays 


The  box  code  arrays  are  packed  twenty  numbers  to  a  word,  so  IBOXW(l.l) 
contains  codes  for  box  (1,1)  through  box  (1,20),  IB0XW(2,1)  contains 
codes  for  box  (2,1)  through  box  (2,20),  etc. 


CMM- 


1 _ fimw. 

J _  MXBST  2JO 

FEXL0C 

TBX14C 

I  WAKE 

1  ISO 

FEXLOC(l)  =  The  location  of  the  leading  edge  at  chord  I,  normalized 
to  BIS  with  1.0  corresponding  to  the  center  of  the  1st 
(subdivided)  row. 

TEXLOC(l)  =  Same  for  trailing  edge. 

IWAKE(I)  =  AftmoBt  subdivided  wing  wake  box  needed  by  the  tail. 
FIGURE  15.  Leading  and  Trailing  Edge  Arrays 
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I  Wtf  /p 


XWLE 

YWLE 

_ _ 

XWTE 

YWTE 

_ talM. _ 

XTLE 

YTLE 

_ btrrt _ 

XTTE 

YTTE 

Platform  edj*  d+F/nttion t  rdcn-dim**sio»*liie<st 
x*d  shift**  mdVmr  re*di*j . 


FIGURE  16.  Planform  Edge  Definitions 


KPTWW 

KPTTT 

KPTRWT 

KPTLWT 


/  2  3 


E 


,‘CHRPS 


NWvJK 


\nttk 


I  MRtNTK 


hfi*n~K 


For  each  AIC  array  needed: 


A/APmS 

muaic  i 
2 


MUAIC (l ,J )  =  first  box  needed  in  row  j 
MUAIC(2,J)  =  last  box  needed  in  row  j 


FIGURE  17,  AIC  Array  Pointers 


The  four  KPT —  arrays  indicate  the  location  on  scratch  file  lAT'.T.C 
of  the  desired  AIC  array  set.  For  example,  KPTT(3)  is  the  AIC  set 
number  (t  matrices  per  set)  of  the  AIC's  for  the  influence  of  the 
left  tail  on  right  tail  chord  3. 
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b.  Arrays  generated  in  the  Modes  Section 

1PNTRM  Pointer  array  for  planform  boxes  on  a  row. 


J  •1234 _ N  N*l 


IPNTRM(1,J) 

1 

2 

5 

10 

61 

89 

IPNTRM(2,J) 

1 

1 

_1_ 

_1_ 

3_ 

0_ 

J  Normally  the  row  number  for  which  the  pointer 

value  is  being  computed.  If  there  are  2  surfaces 
that  are  noncoplanar,  the  value  of  J  representing 
the  first  row  of  the  second  planform  is  MYBW+IOVLAP. 
IOVLAP  is  the  number  of  rows  on  the  tail  planform 
that  have  same  x  coordinates  as  rows  on  the  wing 
planform.  If  there  are  no  rows  with  this  condition 
IOVLAP  is  zero. 


IPNTRM(l,J)  The  sequential  count  +  1  of  all  boxes,  planform 
or  wake  region,  that  are  on  or  between  the  first 
and  last  planform  box  of  all  rows  forward  of  the 
one  J  represents 

IPNTRM(2,J)  The  chord  number  of  the  first  planform  box  on  the 
row  represented  by  J. 


FIGURE  18.  Row  Pointers 


c.  Arrays  Generated  in  the  AIC  Section 


Vn 


The  »  VvmJ  and  Vp/i*  arrays  are  stored  in  a  one  dimensional 

matrix.  For  planar  AIC's  the  and  Vpsj  are  not  computed  and 

the  C  j/fij  array  is  calculated  for  1/2  of  tne  Mach  cone  since  it 
will  be  symmetrical.  If  subdivision  is  applied  then  2  planar  arrays 
are  calculated  with  the  subdivided  array  overlaying  part  of  the  un¬ 
subdivided  array. 


0  I 
r*v-*-r 


2 


*  •  » 


nplk*.* 


0  0-1  0-1-2  *  */  -2-3  o  •  *  • 

III . H  I  II  I  I  I  I  I 


UtVPV 

. — S 


+  /  ... 


ii  rm 


FIGURE  19.  Planar  AIC 
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For  unsubdivided  cases  the  array  ends  when  t  =  NPLKRN .  For  sub¬ 
divided  cases  when  f  =  NPLKRN  the  array  contains  the  subdivided  AIC 
calculated  at  k^k^/NSUBDV.  v  then  is  reduced  to  ,  ] 

and  is  allowed  to  increase  again  until  it  reaches  NPLK$Sor  the  number 
of  rows  to  cover  the  plan form. 

Because  of  the  possible  condition  where  the  receiving  point  of  a 
planform  may  not  be  in  alignment  with  boxes  on  other  planforms  the 
spatial  AIC's  must  be  calculated  on  both  sides. 


MOW 3 


FIGURE  20.  Spatial  AIC's 


INTERNAL  SCRATCH  FILES 


a.  .'.atrix  Format 

All  arrays  written  on  disk  or  tape  files  are  formatted  as  variable 
sized  matrices.  Each  matrix  consists  of  two  logical  records  of 
binary  information,  the  first  one  being  a  l6-word  matrix  identifi¬ 
cation  record,  and  the  second  containing  the  contents  of  the  matrix. 
The  reading/writing  of  these  matrices  is  done  by  subroutines  READMX 
and  WRTMX.  In  the  following  tape  maps,  each  matrix  is  a  separate 
box. 


Matrix  Identification  Record  -  16^^  words 


Word 

Contents 

1 

One-word  ID  label,  an  integer  or  label 

2 

M,  the  number  of  rows  in  the  matrix 

3 

N,  the  number  of  columns  in  the  matrix 

4 

Not  used,  = 

D 

5 

Not  used,  = 

D 

6 

Number  of  words  in  matrix  record 

7 

*1 

8 

Mach  Number 

9 

10 

11 

►  User  parameters ,  array  PARM 

to 

16 

_ 

4 

Matrix  Record  -  variable  length  (word  6  above) 

Ordered  consecutively  by  row,  left  to  right  within  each  row. 


b 


Geometry  Scratch  File  IGEOSC 


This  file  is  generated  in  the  geometry  processor  and  contains  all 
large  geometry  arrays.  The  space  after  the  two  geometry  files  is 
used  for  temporary  scratch  during  mode  shape  processing. 


Matrix  Dimensions _  Parameter  Array 


IBOXW 

M  =  MXBBW*NSUBDV 

N  =  (MYBBSW-l)/NBWRD+l 

PARM(l)  =  0. 

PARM(2)  =  XMACH 

Present  only 
if  NSURF=2  & 
COPLAN= . F , 

IBOXT 

M  =  MXEBST- I XBST+1 

N  =  (MYBBST-1 ) /NBWRD+1 

FEXLOC 

M  =  1 

N  =  MYBSW+MYBST 

TEXLOC 

M  =  1 

N  =  MYBSW+MYBST 

ALPHA 

M  =  1 

N  =  NAL 

IPARM(3)  =  NALPHW 

IJALPH 

M  =  1  | 

N  =  NAL 

► 

* 

EOF 

KPT 

M  *  1,2,3  or  k 

N  ~  max.  #  of  AIC's  needed 
in  the  4  categories 

IPARM(3)  =  NWWK 
IPARM(U)  =  NTTK 
IPARM(5)  =  NRWTK 
IPARM(6)  =  NLWTK 

<H 

•rl 

f 

MUAIC 

M  =  2 

N  =  NROWS 

PARM(U)  =  YBAR 

PARM(5)  =  EL 

IPARM(6)  =  0;  C,W,V 
needed 

1;  W,V 

3° 

MUAIC 

M  =  2 

N  =  NROWS 

Present 

NSPATI 

_ 

NSPATK 

matrices 

_ -A- _ 

needed 

2;  V  needed 

MUAIC 

M  =  2 

N  =  NROWS 

//////////// 


(File  2  is  first  built  on 
IVPSC  by  GEOMBX,  then 
copied  to  IGEOSC.) 


; 


* 

i 

Modes  Scratch  File  MODESC 

This  file  is  generated  in  the  modal  data  processor.  The  deflections 

and  slopes  are  given  at  all  box  centers.  * 


Matrix  Dimensions 


M  =  2 

N  =  NPNTRS  = 
M  =  2 


( MXBW+1  for  single  planform 
\mXBT+10VLAP+1  otherwise 


N  =  IPNTRM(1, NPNTRS)-! 


M  =  2 

N  =  IPNTRM(1, NPNTRS)-! 


IPARM(3)  =  IOVIiA! 


I 


1 
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Thickness  Slopes  Scratch  File  ITSLSC 

This  file  is  equivalenced  to  IWTF3C,  which  is  first  used  in  GEOMBX 
for  temporary  scratch  while  building  the  MUAIC  arrays.  The  thickness 
slope  functions  are  then  written  on  the  file  at  the  end  of  the  modal 
data  processor.  If  NTSLOP  =  0,  one  matrix  of  ones  will  be  written, 
corresponding  to  —'ll  =  0. 
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Spatial  AIC  Scratch  File  IAICSC 


Velocity  Potentials  Scratch  File  IVPSC 

This  file  is  first  used  for  internal  scratch  by  the  geometry  processor 
while  assembling  MUAIC  arrays.  It  is  later  used  in  the  modal  data 
processor  as  temporary  storage  for  the  wing  mode  shapes  to  be  merged 
with  the  tail  modes ,  and  again  for  the  same  purpose  when  working  with 
thickness  slope  functions.  In  the  normal  wash  and  velocity  potentials 
section  it  is  written  with  the  *  and  arrays  for  each  mode. 


DELPHI, 


TVP1 


DELPHI, 


tvp2 


DELPHI 


NM0DE3 


[■VP, 


NMODES 


tiimnnm 


rix  Dimensions 


M  =  2 

N  =  IPNTRM(1,NPNTRS)-1 


M  =  2 

N  =  fMYBSW  if  wing  only 
1 MYBSW+MYBST  otherwise 
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lit.  OUTPUT  FILES 


The  program  generates  three  optional  output  files.  Two  of  them,  the  AIO 
files,  are  designed  for  reuse  with  the  program  during  subsequent  execu¬ 
tions.  The  program  automatically  searches  these  files  and  updates  them 
with  any  new  AIC's  generated. 

The  optional  final  output  file  is  designed  to  pass  the  generalized  air¬ 
forces  matrices  on  for  flutter  or  dynamic  loads  analyses.  It  is  written 
optionally  in  the  forces  section  of  the  program. 
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Matrix  ID 


Contents 


Functi  on 


Parameter  Array 


100001 

100002 

1000MS 

1 

100001 

1000MS 

1 

200001 

2000MS 

* 

i 

NFREQ 


^Model 

(2*MXB*MYB) 

^"Mode2 

(2*.MXB*MYB) 

• 

* 

• 

B^ModeMS 

(2'MYB*MYB) 

<5 

(MS  x  2. MS) 

^Model 

• 

• 

• 

BLModeMS 

5 

MS  x  2. MS) 

B^Model 

• 

• 

• 

^ModeMS 

<3 

(MS  x  2. MS) 

Box  lifts  for  each  mode, 
f  frequency  1  (optional) 


k|,  bj,  Mach  throughout 


Values  for  smoothed  Ajf 
(optional) 


Generalized  airforces, 
frequency  1 


Box  lifts  for  each  mode, 

\  frequency  1  (optional)  ^Values  for  unsmoothed 


Generalized  airforces, 
frequency  1 


Box  Lifts 
frequency  2 


Generalized  airforces, 
frenquency  2 


Values  for  smoothed  Sfi 
(opti  onal) 


Generalized  airforces, 
frequency  NFREQ,  unsmoothed  Ap 


End-of-File 


FIGURE  22.  TAPE  MAP  OF  FORCES  OUTPUT  TAPE 
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15.  IMPLEMENTATION  AND  DEBUGGING 

a.  Update 

The  source  program  is  written  and  maintained  using  the  CDC  6600  SCOPE 
operating  system  UPDATE  feature.  Under  UPDATE,  all  coding  is  either 
part  of  a  *C0MDECK  or  a  *DECK.  A  *C0MDECK  may  be  replicated  many 
times  throughout  the  other  decks.  This  feature  is  used  for  all  global 
labeled  common  blocks  and  for  most  local  common  blocks,  to  insure 
that  all  routines  needing  them  have  identical  common  statements.  A 
few  subroutines  which  are  needed  in  more  than  one  overlay  are  also 
set  up  as  *C0MDECKs.  The  names  of  the  *COMDECKs  and  *DECKs  correspond 
as  closely  as  possible  to  their  Fortran  identifiers  -  program  name, 
subroutine  name  or  common  block  name. 

b.  Open-ended  Features 

The  writers  of  the  program  feel  that  most  potential  users  probably 
have  unique  system  features  which  may  be  utilized  to  optimize  the 
execution  of  the  program  beyond  its  release  status.  With  this  in 
mind,  numerous  "hooks"  have  been  coded  in  to  make  other  features 
easy  to  implement. 

1.  All  references  to  disk  or  tape  files  are  by  name,  rather  than 
by  number.  All  file  names  are  together  in  one  common  block, 
/FILES/.  The  internal  scratch  files  are  defined  in  one  DATA 
statement  in  the  zero  overlay  DRIVER,  and  the  input,  output  and 
AIC  files  are  defined  via  card  input  data. 

2.  All  reading  and  writing  of  internal  and  external  scratch  files  is 
nandled  by  subroutines  READMX  and  WRTEMX.  These  routines  have 
several  calling  parameters  which  are  unused,  but  available  if  it 

is  desired  to  make  use  of  labeling,  random  I.O.,  or  level  numbers. 

'•  Because  READMX  and  WRTEMX  use  BUFFERIN  and  BUFFEROUT,  all  files 
may  share  a  common  buffer  area,  allowing  for  a  considerable 
savings  in  storage  requirements. 

3.  Subroutine  FLUSH  is  always  called  when  a  fatal  error  is  encoun¬ 
tered.  This  routine  may  be  written  to  make  use  of  any  cyctem 
error  recovery  procedure  available.  The  release  version  print. 

a  comment,  flushes  the  OUTPUT  file,  and  terminates  with  a  Mode  1 
error. 

!*,  Subroutine  DTIME  is  called  between  each  secondary  overlay.  The 
release  version  returns  CP  time  only;  however,  provision  is  made 
for  PP  time  if  the  implementing  system  has  that  capability. 

c.  Debugging 

It  is  recommended  that  a  new  user  first  run  one  of  the  sample  data 
cases,  to  familiarize  himself  with  the  program  features  and  to  insure 
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that  the  program  gives  correct  answers  at  his  iiistuiJ  at  ion. 

Tn  the  event  the  program  fails  "hard"  (mode  error,  time  limit,  etc. 
standard  use  of  listings,  load  maps  and  dumps  will  usually  pinpoint 
the  cause. 

If  the  program  executes  but  seems  to  give  bad  numbers,  additional 
intermediate  printout  may  be  helpful.  The  variables  in  common 
block  /CHECKPR/  are  designed  to  control  the  printing  of  additional 
check  values.  Each  variable  controls  printing  from  one  secondary 
overlay,  so  only  the  suspected  area  need  bo  printed.  The  cheek  pri 
provided  are  rudimentary,  so  for  given  problems  additional  prints 
would  probably ■ have  to  be  written,  but  if  they  are  made  conditional 
on  the  common  variables,  they  can  be  .left  in  for  future  needs.  The 
CHECKPR  variables  are  all  read  from  Card  C  of  the  data,  or  may  be  s 
in  an  executable  statement  after  the  call  to  DATAPP. 
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Prog rm  CONTROL 


Primary  level  overlay  which  controls 
the  program  flow 


(  ENTRY  J 


Call  Overlay  (6HAFMB0X,l,l)*  the 
Data  Preprocessor  Section. 


True 


for  this  cycle 
*Mach  no.  f^i*  previous  cycle, 
"and  previous  geometry  desired? 


False 


r 


Call  Overlay  (6HAFMB0X.1.2),  the 
Geometry  Calculation  Section. 


•ViooN 


< 


Call  Overlay  (6HAFMBOX,l,3) .the 
Modal  Calculation  Section 

. . r 


Loop  on  reduced  frequencies 
IKVAL  =  l.NKVALS 

- T - 


Call  Overlay  (6HAFMB0X,l,fc) ,  the 
AIC  Calculation  Section 

I 


Call  Overlay  (6HAFMBOX,l,5) ,  the 
Normal-wash  and  Velocity  Potential 
Calculation  Section 


None 


^Velocity 
-^Potential,^ 


Surface  Fit 


Smoothing  ? 

Chord  Fit 


X 


Call  Overlay  (6HAFMBOX.1.6) ,  for 
Least  Squares  Surface  Fit 
Smoothing _ 


Call' Overlay  (6HAFMBOX,l,7)  for 
Chordwise  Least  Squares  Fit 
Smoothing 


|  Call  Overlay  (6HAFMBOX,l,8) ,  the  Generalized  Forces  Section 
J2H5, — <6moothlnfc?  ft?.  - 


Call  Overlay  (6HAFMBOX,l,8)  again 
for  UnssK>othed  Generalized  Forces 


IKVAL 

"\800 J 


< 


j 


Program  MODES —  Secondary  level  overlay  which  reads  mode  shapes  ami 
thickness  slope  functions 

f  ENTRY  J 

. . . f  ;  _ _ 

j  Real  geometry  data  from  IGEOSC  ~| 


Compute  column  pointer  array 


Call  subroutine  ROPER  to  compute 
row  pointer  array 


Store  row  pointer  array  on  scratch  file 


IPASS  =  1,2  | 


^  NS  *  l.NSlfflF 


y  UM  =  1,N MODES  I 

r  _ 


Read  mode  shapes  for  1st 

planform  if  calculating  2nd  planform 


Polynomial 

Coefficients 

1 


Read  polynomial 
coefficients 


Box  Center  Input 


Least  Squares 


Surface 


Read  modal  input  at  box 
centers  and  reorder  for  storage 


Read  modal  data  and  call  subroutine 
FITTER  to  fit  polynomial  equation 


Compute  deflections  and  slopes  at  box  centers 


Write  the  modal  data  on  intermediate  file  if  1st 
of  2  surfaces, on  final  file  if  only  1  surface  or 
2nd  surface 


Read  thickness  slope  values  or  create  a 
function  of  1,0  and  store  on  the  scratch 
file 


-IPASS 


89 


Program  VI CHAIN  —  Secondary  level  overlay  which  calculates  all 
Aerodynamic  Influence  Coefficients 


f  ENTRY  J 


*<z  NV«  1 tNVCS (#  of  AiC’S j  j 


Planar 


Spatial 


Set  KUAIC  pointer  array 


Read  MUAIC  pointer  array 
from  geometry  scratch  file 


Read  AIC  array 
froa  tape 


Call  Subroutine  KERNEL 
(Determines  limits  of 
integration  for  each  box 
Stores  Bessel  functions 
for  later  use.) 

3 


Subroutine  RANGE  (Give  max 
order  of  Bessel  function) 


0 


Subroutine  BESSEL  (Computes  the 
Bessel  functions  for  a  row  of 
boxes. ) 


Subroutine  ROHBER (integrates 
the  AIC  functions  by  using 
Romberg  integration  technique 


I 


Store  on  permanent  file 
if  specified 


Spatial 


Subroutine  FUNCT  (To 
compute  the  value  of  the 
integrand  for .velocity 

Subroutine  BFUNC  (Retrieves' 
Bessel  function  from 
stored  array.) 


I 


2 


Subroutine  VPUNC  (To\ 
compute  the  value  of 
the  integrand  for 
sidevash  terms) 


Store  on  permanent  file 
if  specified. _ 


H 


I 


Store  on  scratch  file 


(  RETURN  ^ 
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Program  NWVLrT  Secondary  overlay  which  calculates  normal  washes  and 
velocity  potentials. 


Read  Box  codes  from  IGEOSC  into  array 
IBOXW  (2nd  read  for  out-of-plane  tail) 


Read  FEXLOC  and  TEXLOC  arrays  from  IGEOSC 


If:  PSIwfo  £  DIHW-.T. 
or^PSIT#  It  DIHT*.T. 

of  PSIDIFyo  S  - 

or\  CAPI^O  X| 
or  ISHPLW^O^^  SS/S!? 


Read  spatial  AIC  table  of  con¬ 
tents  from  IGEOSC  into  array  PA1C 


- KJCHRD  »  l.ISMPLWl 

Call  SMPLW,  which  computes  and 
prints  the  downwash,  sldewash  and 
longitudinal  wash  for  the  desired 
_ chord. _ > 


SMTH 


Secondary  overlay  which  smooths  velocity  potentials 
by  fitting  a  least  squares  surface  through  them 


Write  the  new  velocity  potentials  on  a 
scratch  file. 


/ 


Program  FORCE  Secondary  overlay  which  computes  box  lifts 
section  lifts,  end  generalized  air  forces 
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APPENDIX  A 


SAMPLE  INPUT  AND  OUTPUT  DATA 


A  simple  spatial  configuration,  shown  in  Figure  23  »  was  chosen  as  a 
sample  problem  for  the  demonstration  of  the  card  data  input  and  a 
selection  of  the  printed  output.  The  planform  used  is  a  pair  of  iden¬ 
tical  rectangular  surfaces  (wing  and  tail)  with  small  horizontal  and 
vertical  separation. 


FIGURE  23  SAMPLE  PROBLEM  CONFIGURATION 


The  configuration  was  analyzed  at  Mach  1.2  for  a  reduced  frequency 
(based  on  semi-span)  of  .5.  Only  the  wing  surface  was  allowed  to 
oscillate,  in  plunging  motion  for  mode  1  and  in  pitch  about  the  wing 
leading  edge  for  mode  2.  These  two  modes  were  input  on  cards  as  poly¬ 
nomials,  Chordwise  velocity  potential  smoothing  was  requested. 

In  the  interest  of  space  the  printout  was  edited  to  give  samples  only. 
A  few  pages  of  one  spatial  AIC  array  and  the  planar  AIC  are  included, 
as  well  as  most  of  the  computations  for  mode  2  (wing  pitch).  Since 
for  this  configuration  the  upper  and  lower  surface  normal  wash  differs 
only  in  sipi,  only  the  upper  normal  vashes  are  included.  The 
generalized  force  calculations  at  the  end  are  for  smoothed  velocity 
potentials. 


A1 


Card  Input  Data 


AfMCOX  1  0 

SAMPLC  CASC  —  iWD  AR=2  SURFACES  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 
KARCO  XMACH=  1.20  * 

KARDC  SrM=l.O,MTYPEW:l  ,HTYFET=1  ,NSURF=2  iWTCNAF  = .  T.  ,WTBL=.T.  i 
PRCNAC=.T.  ,  PRDCFs.  T.  , 

PLYVAXX)  =  .T.  , 

CRDFI T=. T. iNCCC-4  , 

FRONAFs .  T.  ,PRDL=.T.  ,PRSLs .  T.  ,PfiPAlC= .  T.  ,PSSA!C=.T.  ,PRCC€F=.T.  , 

PRDOX=.T.  ,PRVF=.T.  ,CXAi:=.F.  ,  PRNWs.T.,  PRHX$=.T.  S 
SCARED  S 


SCARDE 

II 

</> 

* 

X 

.50 

S 

SCARCE 

TLAX=1 .20 i 

TLAZ-  .40 

s 

SCARED 

NCHRCS=10i 

XECGE-0.00 

s 

2 

2  2 

2 

CARD  H 

0. 

0. 

0. 

1.0 

CARD  I 

1.0 

0.0 

1.0 

1.0 

CARD  J 

0. 

0. 

0. 

1.0 

CARD  K 

1.0 

0.0 

1.0 

1.0 

CARD  L 

SCAREM 

NKCC  S=2  S 

2 

1. 

0. 

0. 

0. 

0. 

0. 

WIND-1 

2 

0. 

1. 

0. 

0. 

0. 

0. 

WIND-2 

1 

0. 

0. 

0. 

TAIL-1 

1 

0. 

0. 

0. 

TAIL-2 

A2 


PRINT  HDKHUL  WASHES 

PRINT  Ti  Z  VELOCITY  POTENTIALS 

PRINT  T tC  B>'JX  LIFTS 

PRINT  TPC  SECTION  LIPTS 

PRINT  PRESSURE  EIFPERENCE  CCCFFICIENTS 


SAMPLE  CASE - IVO  AR=2  SURFACES  WITH  HDRI2DNTAL  AND  VERTICAL  SEPARATIONS 


A  6 


F 


SAMPLE  CASE - TVC.  AR=2  SORT  ACCS  Ul  TH  HC-RIZCNTAL  ANE  VERTICAL  SEPARATIONS 
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•o 
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10  *0 


ENTERING  PR CORAH  HjCCS  CUKZCHT  CLArSCC  TIME  IS  CP  =  1.694,  FF  =  4C.223 


SAMPLE  CAS C  —  TWO  AR=2  SURFACES  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 
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4 

3 
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5 
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M 

a 
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z 

Li 

U 

It 

§ 

-J 
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O  X 
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Q  X 


oooooooooooooo 


OOOOOOOOQOOOOO 


ooaaoddodadddo 

iliilliliilili 
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oooooooooooooo 


ooogooggggQQQg 

88888858838088 

ddddddddddcdod 


oooooooooooooo 


oooooooooooooo 


ENTERING  FRCGRAM  AIC  CURRENT  ELAPSED  Ttb£  IS  CF  =  2.555,  FF  =  44.910 


•AMPLE  CASE - TWO  Afi.=2  SURFACES  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 
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SAMPLE  CASE - TWO  AR*Z  SURFACE S  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 

WINS  UPPER  SURFACE  NORMAL  WASH 
(  MACH  1.C00  RED.  FHCR.x  .30000  ) 

NODE  SHAPE  2 


SAMPLE  CASE - TWO  AA*2  SURFACES  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 

WING  UPPER  SURFACE  NORMAL  WASH 
(  MACH  1.200  RED.  FRE4.3  .50000  ) 

NODE  SHAPE  2 
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SAMPLE  CASE - two  ARs*  SURFACES  WITH  HORIZONTAL  ANC  VERTICAL  SEPARATIONS 

SMOOTHED  WIND  VELOCITY  POTENTIALS 

(  MACH  t.ZQO  RED.  FRER.  =  .50000  ) 
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SAMPLE  CASE - TWO  AR*t  SURFACES  WITH  HORIZONTAL  AND  VERTICAL  SEPARATIONS 
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APPENDIX  B 


A 


PROGRAM  LISTINGS 


OVERLAY  tAF»CCl)(, 0,0) 

HtQCRAM  DRIVER  UNPUT, OUTPUT, TAPE5-INPUT,TAPE6=CUTPUT,TAPei=1000, 

1  TAPE2=1000 , TAPE3=1000 . HOCESC  =110,IVPSC=110,IGE06C=110, 

t  IWTfSC=110,IA!CSC=110) 

THIS  IS  A  DUH4Y  03,0)  OVERLAY  DRIVING  PR CCR AM 

00*04  PK£RH_<1640) 

COMPLEX  «*ERN- 

00*04  /HUES  /  NT5,MT6, INTAPE, DFSP.NRJUC.NSPAIC.NOUTP, 

1  IOUFSP«MCCESC>  IVPSC,  IGEC6C,  IWTFSC,  IAICSC 

00*04  /ARRAYS/  KBXCCW,LBXCCW,LBC«C,KBXCDT,LBXCOT,KJALW,LJALfH, 

1  KALH4AiKKERM.,LKERN.iKPNTRM,LPNTRM,KDEFSL,KELWI , 

2  LMCCES ,  KPNTSD ,  LPNTSD  ,  KSDW,  LSDW,  K  PNTDW,  L  PNTDW, 

3  KDW.LDW.KTVP.LTVP 

DATA  ITPE1, HOCESC, IVPSC.IGEOSC, IWTFSC, IAICSC/ 

1  5LTAPa,6LMCCESC,5UVPSC,6LI0eC6C,6LIWTF5C,6LlAICSC  / 

NTS  =  5 
NTS  =  6 

READ (5, 5)  LIf*,U,L2 
3  FORMAT (A6,4X,2I10) 

WUTE<6,6>  LIMCiLl ,L2 
6  FORMAT  1*1  PROCRAM  BEGINS  *,A6,2I5) 

CALL  OVERLAY  (LI  NC.L1,L2,0) 

VRITEC6.7) 

T  FORMAT («0  PROGRAM  TERMINATES*) 

CALL  EXIT 
ETC 


DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

FILES 

FILES 

ARRAYS 

ARRAYS 

ARRAYS 

ARRAYS 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 

DRIVER 


00002 

00003 

00004 

00003 

00006 

00007 

00008 

00009 

00010 

00011 

00002 

00003 

00002 

00003 

00004 

OOOOS 

00014 

00015 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

00023 

00024 

00025 

00026 


1 


u  u  u 


c 

c 

c 

c 

c 


OVERLAY  <An«  OX,  1,0) 

PROGRAM  CONTROL 

SUPERSONIC  UNSTEADY  AERODYNAMICS, 

WING  /  HORIZONTAL  TAIL,  VERTICAL  SEPARATION,  DIHEDRAL 

THIS  PRIMARY  OVERLAY  CONTROLS  THE  CALLING  CF  THE  COMPUTATIONS 
SECTIONS  OP  THE  PROGRAM 

THIS  IS  THE  TOTAL  COAOI  FCR  ALL  THE  OVERLAY  STRUCTURE 
CCMMON  /CONTRL/  PREVEX.CMACH,  TITLE (8) ,  HtVGECM,  H5VH0CE, DIHW, DIHT , 
1  DEFAULT 

LOGICAL  PRVGEOM.fRVHCCE, DIHW, DIHT, DEFAULT 

CO4V0N  /FRCBLM/  XHACH ,  fACCES ,  NTSLOP.  NtVALS ,  SMOOTH ,  fCEG,  CR DFI T , 

1  EXA I  C.SUBCV,  PLYWOOD 

LOGICAL  SMOOTH, CRDFIT.EXAIC.SUBDV.PLYWXD 

CO4V0N  /CECHTY/  COFLAN.NSUBDV,  XSLBDV,  NSUBDZ.fCUBCN.HSURF, 

1  Bl, BIBETA. B1,,B1BTAS,W_AX,ULAZ,PSIW, 

2  MX8W,  MXBBW,  W  BW,  HTBBW,  MXBSW,  Mf  DSW,  MYBBSW, 

9  IX8W,  XCENTR 

LOGICAL  COPLAN 

OOWCN/CECK2  /  TLAX,TLAZ,PSIT ,MX8T,MfBT,MYBBT,M)©5T,  WEST, 

1  MTBBST.IXBT.IXBST.CAPL 

COMCN  /  KERN  /  ERR,HXSKRN,IPRERN,NPLKRN,NSFATK,N?CWEA 
CCP4CN  /KVAL  /  IKVAL.  WVAL (20)  ,  *CS(2D> 

COMCN  /FILES  /  NT5.NT6, INTAPE, DFSP.NPLAIC.NSPAIC.NOUTP, 

1  iajRSP.MODCSC.IVPSC.ICECSC.IWfFSC.IAICSC 

COMON  /IOCONT/  CPLAIC,C6FAIC,WrGECM,WTGNAF,WTSLiWTCLi PRBOX, 

1  PRFAIC,PRSAIC,PRMCCS,PRCCEF,PRCW,PRSW.PRVP, 

2  PRBL,PRDCP,PRGNAF,fRGNAC,PRSL.PRLW,PRNW.PRCM 
BWI  VALENCE  (PRUW.PRDW) 

LOGICAL  OPLAIC,06FAIC,WTGEQN,WTCNAF,WrSL,WTBL,  PRBOX,  PRPAIC, 

1  PRSAIC,  PR  MODS,  PRCOEF,  FRCW,  PRSW,  PRVP,  PRBL.  PRSL,  PRCNAF, 

2  IRDCP,»RGNAC,fRUW,PRLW,PRfW,PRCM 

OHCN  /TAPEIOT  *FS,NMS,LS,NPR,ID(2Q)  ,NJD,  ITYPE,LRS,LWS,M,N, 

1  FARM(IO) ,  IRR 

DIMENSION  IPARM(IO) 

QUI  VALENCE  (FARM, ’FARM) 

COMMON  /  MODES/  SYM.SYMT ,  MTY  FEW,  MTY  PET 

COKh  /ARRAYS/  KBXCCW.LBXCDW.LBCNC.KBXCBT.LBXCDT.KJALPH.LJALFH, 

1  XALPHA,KAERN.,LXERN.,XPNTRM,LFNTRMlKDEF5LiKELPHI , 

2  LMCCE5,KPNTSD,LPNTSD,KSCW,LSDW,KPNTCW,LPNTCW, 

3  KOW.LDW.KTVP.LTVP 

CO*TCN  /SAMPLE  ISM^W,  ICHCRD(IO) ,  IBOXF (10)  ,1600.(10)  ,ZLCC(10) 
CCMMON  /PLANXY/  H4.E,NWTE»NTLE,NTTE,  XHLE(IO)  ,YVLE(IO) , 

1  XWTE(T0),YWrE(10>,  XTLE(IO)  ,YTLE(IO) , 

2  XTTE(IO)  ,YTTE(10) 

CCPHCN  /CHECK PR/  BPPCPR.CEOCPR.HCDCPR .AICCPR ,NWSC»R,SMCPR .CAFCPR 
logical  CPFCPR,  ceocpr,  hcccfr,  aiccpr.nwscpr,  smcpr,  CAFCPR 

CCMMON /RVeUFF/  BFCOTE, I BFCNT,  BUFF<3280> 

DATA  BFCODE.IBPCNT  /  8HBUFFSIZE.3280  / 

DATA  TCVU7  /«HAF)«OX  / 

DATA  PREVEX  /10HPCVER  EXEC  / 

DATa  EXEC  /10HAFPCOX  E*C  / 

CALL  RDINiT 
1  CONTINLf! 

PfiOC  ;  ENTATAPP 


CONTRa 

CONTROL 

CONTRa 

CONTRa 

CONTRa 

CONIRa 

CONTRa 

CONTRa 

CONTRa 

CONTRa 

CONTRL 

CONTRL 

CONTRL 

FRCBLM 

FRCBLM 

FRCBLM 

GECMTY 

CECHTY 

CECHTY 

CECHTY 

CEOOY 

GEOC 

CECME 

KERN 

KVAL 

FILES 

FILES 

IOCCNT 

ICCCNT 

BCSFRB 

IOCCNT 

ICCCNT 

ICCCNT 

BCSFRB 

TAPEI0 

TAPEIO 

TAPEIO 

TAPEIO 

MCDCCM 

ARRAYS 

ARRAYS 

ARRAYS 

ARRAYS 

SAMPLW 

PLANXY 

PUNXY 

PLANXY 

CHECK  PR 

CHECKPR 

RWOUFF 

BCSCNA 

FTNXt 

FTNX1 

rTNXt 

CCNTRa 

CONTROL 

CCNtRCL 


00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00G14 
00002 
00003 
00004 
00002 
00003 
00004 
00002 
00003 
00004 
00005 
00006 
00002 
00003 
00002 
00002 
00002 
00003 
00002 
00003 
00001 
00005 
00006 
00007 
00002 
00002 
00003 
00004 
00005 
00002 
00002 
00003 
00004 
00005 
00002 
00002 
00003 
00004 
00002 
00003 
00002 
00001 
00002 
00003 
00004 
00030 
00031 
0003  ’ 


u  u  u  u  u  u  u  o 


CAUL  OTINE(CPTIME, PPTIME) 

WIITE  (KT6,E005)  PR  OC.CPTIME,  PPTIME 
W05-FCRMAT(lX0,10X,<NTERtNC  PROGRAM  *,A6,*  CURRENT  ELAPSED  TIME 
t  *  CP  =*,F8.3,*,  PP  =*,P8.3  ) 

CAUL  OVERUYITEV147, 1,1,0) 

PARMO)  =  XmCM 
IPARM(5)=  HlVALS 

IF  (GMAOI  .EB.  XMACH  .AfC.  FRVGECM)  GO  TO  100 
C 

mot  3  etcecx 

CALL  DTIKE  (CPTIME*  PPTIME) 

WIITE  (NT6, 6005)  (ROC,  CPTIME,  PPTIME 
C  COMPUTE  GEOMETRY  SECTION 

CALL  OVERLAY aEVlAT.l, 2,0) 

C 

C  READ  MODE  SHAPES,  PUCE  IN  INTERNAL  STORAGE  CONVENTION, 

C  STORE  CN  SCRATCH  RLE.  COMPUTE  ANC  STORE  OPTIONAL 

C  THICK fCSS  SLOPE  FUNCTIONS 

C 

100  CONTINUE 

IF  (TKVALS  .LE.  0)  CO  TO  810 
mot  =  6HMCDE5 
CALL  BTIME(CPTlME.  PPTIME) 

WIITE  (NTS, 6005)  FROG, CFTIHE, PPTIME 
CALL  OVERLAY  (TEV147, 1,3,0) 

SPACE  OUTPUT  TAPE  IF  DESIRED 
IF  (NOUTP  .LE.  0)  CO  TO  200 
IF  (PREVEX  .NE.  EXEC)  REWII-C  NOUTP 

RLE  SPACING  A  FUNCTION  OF  INSTALLATION  CAPABILITIES 
200  CONTINUE 

LOOP  ON  NUKSER  OF  K1  VALUES  THIU  KERNELS.  DOWMASHES  AW) 
AIR  FORCES 

DO  800  IKVAL  =  l.NtVALS 

CALL  KERNEL  ROUTINES 
moc  =  CHAIC 

CALL  DTIME(CPTItE.PPTINC) 

WIITE  (NTS, 6005)  fRCC,CPTIN€, PPTINE 
CALL  OVERUV(TEVl4T, 1,4,0) 

C 

mot  r  6HVELPCRT 

CALL  DTIME (CPTINC, PPTIME) 

WIITE  (NT6.6005)  FROG, CPTIME, PPTIME 
C  CALL  DOUNWASH  AND  VELOCITY  POTENTIAL  ROUTINES. 

CALL  OVERUY (TEV147,1 , 5,0) 

C 

IF  (.NOT.  SMOOTH)  CO  TO  600 
IF(CRDRT)  GO  TO  600 
C 

mot  r  6MSMOOTH 

CALL  DTIMEt.PTIHE,  PPTIME) 

WIITE  (NT6.6005)  mot, CRIME, PPTIME 
CALL  OVERUY  (TEV1 4 7, 1,6,0) 

CO  TO  700 
C 


CONTROL  00033 
CONTROL  00034 
IS  *  CONTROL  00035 
CONTROL  00036 
CONTROL  00037 
CONTROL  00038 
CONTROL  00039 
CONTROL  00040 
CONTROL  (YY)41 
CONTROL  OOU  ' 
CONTRa  00043 
CQNTRCL  00044 
CONTRa  00045 
CONTRa  00046 
CONTRa  00047 
CONTRa  00048 
CONTRa  00049 
CONTRa  00050 
CONTRa  00051 
CONTRa  00052 
CONTRa  00053 
CONTROL  00054 
CONTRa  00055 
CONTRa  00056 
CONTRa  00057 
CONTRa  00058 
CONTROL  00059 
CONTRa  00060 
CONTRa  00061 
CONTRa  00062 
CONTRa  00063 
CONTRa  00064 
CONTROL  00065 
CONTRa  00066 
CONTRa  00067 
CONTRa  00068 
CONTRa  00069 
CONTRa  00070 
CONTRa  00071 
CONTRa  00072 
CONTRa  00073 
CONTRa  00074 
CONTRa  00075 
CONTRa  00076 
CCNTRa  00077 
CONTRa  00078 
CONTRa  00079 
CONTRa  00080 
CONTRa  00081 
CONTRa  00082 
CONTRa  00083 
CONTRa  00C64 
CONTRa  0C085 
CONTRa  00086 
CONTRa  00087 
CONTRa  00088 
CONTRa  00089 


COO  CONTINUE 

IF(.NOT.CRCFlT)  CO  TO  TOO 
C 

mot  =  6HCHCRDF 

CALL.  DTIME(CPTTME,  PPTIME) 

VRITE  (NT6.6005)  PRCC,  CPTIME,  PPTIME 
CALL  CVERLAY  (TEV147, 1,7,0) 

C 

TOO  CONTINUE 

(ROG  -  ENFORCES 

CALL  DTIME  (CPTIME,  PPTIME) 

WRITE  (NT6.6005)  FRO&.CPTtME,  PPTIME 
CALL  CVERLAY  (TEV147.1 ,8,0) 

IFt.NOT.  (SMOOTH.  CR.CRCFIT)  5  CO  TO  800 
NIVPSC  =  IAICSC 
IAICSC  =  IVPSC 
IVPSC  =  NIVPSC 


CONTROL  OOOSQ 
CONTRa  00091 
CONTROL  00092 
CONTRa  00095 
CONTRa  00094 
CONTRa  00095 
CONTRa  00096 
CONTRa  00097 
CONTRa  00098 
CONTRa  00099 
CONTRa  00100 
CONTRa  00101 
CONTRa  00102 
CONTRa  00105 
CONTRa  00104 
CONTRa  00105 
CONTRa  00106 


CALL  DTIME  (CPTIME,  PPTIME)  CONTRa  00107 

WRITE  (NT6.6005)  PROG.CFTIME,  PPTIME  CONTRa  00108 

'(RITE  (NT6.6010)  CONTRa  00109 

6010  FCRMAT(1H0,5X,90(1H*)  ,///6X,  ^PROGRAM  FORCES  IS  BEINC  RECALLED  TOC  CONTRa  00110 

1CMPUTE  AIR  FORCES  WITHOUT  SM00THINC.*//6X,90(1H*>  )  CONTRa  00111 

CALL  OVERLAY  (TEV147, 1,8,  EHRECALL  >  CONTRa  00112 

C  CONTRa  00115 

800  CCNTINJE  CONTRa  00114 


C  END  OF  LOOP  ON  REDUCED  FREQUENCIES 

C 

810  CONTINUE 

IF  (NOUTP  .GT.  0)  REUITC  NQUTP 
IF  (NPLAIC  .GT.  0)  REWIND  NFLAIC 
IF  (NSPAIC  .GT.  0)  REWIN)  N5FAIC 
CALL  CTIMETCPTIME, PPTIME) 

VRITE  (NT 6, 6006)  CPTIME, PPTIME 
6006  FORMAT <1HO,10X*FROGRAM  COMPLETED  *,6X,*  CURRENT 
I  *  CP  =*,FB.3,*t  PP  =*,F8.3  ) 

READ<5,8005)  LIN(.Lt,L2 
6005  FORMAT  (A6.4X,  >110) 

C 

C  DETERMINE  IF  ANOTHER  CYaE  IS  WANTED. 

C  IF  U  =  -1,  RECYCLE 

IF(L1  .E9.-1)  CO  TO  1 

C  IF  LI  =  -2,  RETVRN  TO  CALLING  FROCRAM 

IF(Ll.EQ.-2>  RETURN 
C  IF  LI  =  0,  CAU  EXIT 

IF(L1.E8.0)  CALL  EXIT 
C  IF  LI  =  PC6.  CAU  OVERLAY 

IF(Ll.CT.O)  CALL  CVERLAY(LIN(,L1,L2,0> 

DC 


CCNTRa  00115 
CCNTRa  00116 
CONTRa  00117 
CCNTRa  00118 
CCNTRa  00119 
CONTRa  00120 
CCNTRa  00121 
CCNTRa  00122 
ELAPSED  TIME  IS  *  CCNTRa  00125 
CONTRa  00124 
CONTRa  00125 
CCNTRa  00126 
CCNTRa  00127 
CCNTRa  00128 
CONTRa  00129 
CONTRa  00150 
CONTRa  00151 
CCNTRa  00132 
CONTRa  00133 
CCNTRa  00134 
CCNTRa  00135 
CCNTRa  00136 
CONTRa  00137 


B5 


sum  out  i  ne  flush  a)  flush 

C  FCUTIfC  TO  FCRCE  AN  ERRCR  EXIT  FLUSH 

DIMENSION  MESACE(4)  FLUSH 

DATA  tCSACC  /10H  PROCRAM  F.iOHLUSHED  VIA.10H  MODE  1  ,  0  /  FLU3H 

DATA  MTS  /SLOUTPUT/  FLUSH 

MUTE  (MTS  1 8000)  (MESACE(I)  »I=1 ,3)  FLUSH 

EJCFILE  MTS  FLUSH 

CALL  REMARK  (MESA C£>  FLUSH 

CALL  FL3HXXX  FLUSH 

8000  FORMAT  <SHO***  ,  3A10.  4H  ***)  FLUSH 

END  FLUSH 


00002 

00003 

00004 

00005 

00006 

0000? 

00008 

00009 

00010 

00011 

00012 
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•COROUTINE  RCIHIT 

CCMMCN  /TARCl<y  NFS.WC.U.WC.tDtaQl.NlD.ime.Utt.LVC.M.N, 
1  RARMUO),  IRR 

OIMENRIQN  I  All) 

(BUI VALENCE  (!A,>r») 

CO  10  !>  1,41 
IA(!)  a  0 
10  CONTINUE 
WO  a  20 
RETURN 
DC 


ROINIT  00002 
RDINIT  00003 
ROINIT  00004 
ROINIT  00009 
RDINIT  00006 
ROINIT  OOOOT 
ROINIT  00006 
RDINIT  00009 
RDINIT  00010 
RDINIT  00011 
RDINIT  00012 


SLOROUTItC  DTINEICRTIME.miME) 

ROUTINE  TO  INTERROGATE  THE  SYSTEM  CLOCKS 

mite  *  o 

CAU.  SCCCKHCRTIME) 

RETURN 

END 


OTIME 

00002 

DTI  ME 

00003 

OTIME 

00004 

OTIME 

00005 

OTIME 

00006 

OTIME 

00007 

B8 


SUBROUTINE  READMX(INFILE,MW<EAD,RAH)IN,  NFS,  ms,  US,  NH<,  K,  NID, 

READMX 

00002 

1 

ID,  I TV PE,  IRS,  A.  M,  N.  PARK,  IRP  > 

READMX 

00003 

READMX 

00004 

ROUTINE  TO  READ  A  MATRIX  ON  TAPE  CR  DISK  FILE. 

READMX 

00003 

THIS  VERSION  WILL  WORN  WITH  SEQUENTIAL  FILES  CH.Y. 

READMX 

00006 

sac  VARIABLES  are  passed  FCR  RANDOM  OPERATION  but 

READMX 

OOGQT 

ARE  NOT  CURRENTLY  USED. 

READMX 

00008 

READMX 

00009 

INPUT  - 

READMX 

00010 

IMFILE  - 

TAPE  NUMBER  CR  LEFT  ADJUSTED  FILE  NAME 

READMX 

00011 

MWEAD  - 

•  T.  SMART  FCR  MAT  (NOT  USED) 

READMX 

00012 

.F.  TELOOl  FORMAT 

READMX 

00013 

RAMHN  - 

.T.  RAtCCM  FILE  (NOT  USED) 

READMX 

00014 

.F.  SEQUENTIAL  FILE 

READMX 

00013 

»« 

NUMBER  OF  FILES  TO  SPACE 

READMX 

00016 

ms 

NUMBER  CP  MATRICES  TO  SPACE 

READMX 

0001 T 

LS 

LEVEL  NUMBER  TO  SPACE  (NOT  USED) 

READMX 

00018 

T*R 

IDENTIFIER  (NA'-'E  CR  NUMBER)  (NOT  USED) 

READMX 

00019 

K 

ROM  DIMENSION  OF  ARRAY  A 

READMX 

00020 

(IF  R:0,  MATRIX  WILL  BE  LEFT  IN  /RVCUFF/ .  IT  WILL 

READMX 

00021 

BE  STCRED  AS  A  ROW-WISE  MATRIX,  NOT  AS  A  FORTRAN 

READMX 

00022 

COLUMN-WISE  MATRIX.  M-RCV6  AM)  N- COLUMNS  ) 

READMX 

00023 

NID 

NUMBER  CP  WORDS  AVAILABLE  IN  ID  ARRAY 

READMX 

00024 

I  tV  CUT 

READMX 

00025 

ID 

IDENTIFICATION  ARRAY 

READMX 

00026 

I  TYPE  - 

REAL ,  DI  AGONAL ,  NULL  .MIXED,  COMPLEX 

READMX 

00027 

OUTPUT  - 

READMX 

00028 

UJS 

LEVEL  NUMBER  CP  MATRIX  READ  (NOT  USED) 

READMX 

00029 

A 

ARRAY  CONTAINING  MATRIX 

READMX 

00030 

M 

ROW  DIMENSION  OF  MATRIX 

READMX 

00031 

N 

COLUMN  DIMENSION  CP  MATRIX 

READMX 

00032 

PAfiM  - 

ARRAY  OF  NUMERICAL  PARAMETERS  STCRED  WITH  THE  MATRIX 

READMX 

00033 

IRR 

REACKX 

00034 

0,  NO  ERROR 

READMX 

00035 

1.  MATRIX  SPACING  IS  NEGATIVE 

READMX 

00036 

2,  FILE  SPACING  IS  NEGATIVE 

READMX 

00037 

4,  MATRIX  DIMENSIONS  ILLEGAL 

READMX 

00038 

3,  M  .GT.  X 

READMX 

00039 

1500  ♦  l,  ENCOUNTERED  ’  1  ’  AFTER  MATRIX  I  VHILE 

READMX 

00040 

SKIPPING  MATRICES. 

READMX 

00041 

READMX 

00042 

DDOSICM  IDtl) ,  A(X,1) ,  PARMUO),  3(16) 

READMX 

00043 

READMX 

00044 

COMCN  /RVCU5T/  BFCaE.IBFCNT,  BUFF<3280) 

READMX 

00045 

READMX 

00047 

DIMENSION  IBUFF(2500> ,  1  ?ARM(10> ,  18(16) 

READMX 

00048 

EQUIVALENCE 

(BUFF,IBUFF),(B,!8> 

READMX 

00049 

READMX 

00050 

LOGICAL  MMEAD.RANDIN 

READMX 

00051 

IRR  =  0 

READMX 

00052 

READMX 

00053 

DO  FILE  SPACING 

READMX 

00054 

READMX 

00055 

IF(tTS)  213,230,220 

READMX 

00056 

213  CONTINUE 

READMX 

C0057 

IRR  s  2 

READMX 

00058 

GO  TO  1000 

READMX 

00055 

B9 


220  CONTINUE  READMX 

00  225  !s|,  READMX 

222  CONTINUE  READMX 

SUFFER  IN  IltmC.t)  (BUFFU),BUFF(IBFCNT>)  READMX 

221  CONTINUE  READMX 

IFUMT.ItnUE)  221,222,225  READMX 

225  CONTINUE  READMX 

250  CONTINUE  READMX 

C  READMX 

C  DO  MATRIX  SPACING  READMX 

C  READKX 

IFOMS)  235.250,240  READMX 

235  CONTINUE  READMX 

IRR  =  1  READMX 

CO  TO  1000  READMX 

240  CONTINUE  READMX 

NC  =  WS  ♦  N6  READMX 

DO  245  I=1,WC  READMX 

BUFFER  IN  (IWILE.l)  <BUFF(1),BUFF<IBFCNT>>  READMX 

241  CONTINUE  READMX 

iFtUNIT.ItnLE)  241,242,243  READMX 

242  CONTIMJE  READMX 

CO  TO  245  READMX 

243  CONTINUE  READMX 

IRR  =  1500  ♦CI*l)/2  READMX 

CO  TO  1000  READMX 

245  CONTI  HC  READMX 

290  CONTINJE  READMX 

C  READMX 

C  READ  B  HEADER  CARD  READMX 

C  READMX 

BUFFER  IM  <I*1LE,1)  <B<1)  ,B(16) )  READMX 

300  CONTINUE  READMX 

IF  (UNIT.IFfTLE)  300,310,305  READMX 

305  CONTINUE  READMX 

IRR  =  1500  ♦  NC  M  READMX 

CO  TO  1000  READMX 

MO  CONTINUE  READMX 

C  READMX 

C  BET  PARAMETERS  A  EC  SIZES  READMX 

C  READMX 

ID<2)  =IB(1)  READMX 

M  =IB  (2)  READMX 

N  xIBCS)  READMX 

NTN  =18(5)  READMX 

DO  325  1=7,16  READMX 

FKRMd'6)  =  B«I)  READMX 

325  CONTINUE  READMX 

C  READMX 

C  TEST  F«  FRCFER  SIZES  READMX 

C  READMX 

IF(M.CT.0.AH>.M.CT.0.A«5.MTN.LE.IBFCNT)  C0T0  35C  READMX 

IRR  *  4  READMX 

CO  TO  1000  READMX 

350  CONTINUE  READMX 

C  READMX 

C  READ  THE  AfiRAT  READHX 


00060 

00061 

0X62 

0X63 

0X64 

0X65 

0X66 

0X67 

0X68 

0X69 

0X70 

0X71 

0X72 

0X73 

0X74 

0X75 

0X76 

00077 

0X78 

0X79 

0X80 

00081 

00082 

00063 

00084 

00085 

00086 

00087 

00088 

00069 

00090 

00091 

00092 

00093 

00094 

00095 

00096 

00097 

00098 

00099 

XIX 

X101 

X102 

X103 

X104 

X105 

X106 

X107 

X108 

X109 

00110 

Xlll 

X112 

X113 

00114 

X115 

00116 


BIO 


► 


► 


► 


c 

400  CONTJ HUE 

Bum*  IN  UfFILE.l)  (BUFF  U>,  BUFF  <MTN>) 

410  CONTINUE 

IF  <UNXT, UTILE)  410,420,415 
415  CONTINUE 

IRR  =  1500  «ue  +1 
SO  TO  1000 
420  CONTINUE 
C 

C  IF  K=0  LEAVE  THE  **T*IX  IN  THE  BUFF  AREA  AND  EXIT 

C  IF  K.CT.O  TRANSFER  BUFF  TO  ARRAY  A 

C 

IFOl.LE.O)  so  TO  1000 
C 

C  TRANSFORM  BUFF  TO  ARRAY  A 

c 

IFaTYPE.Ea.7XCHfT.EX)  CO  TO  475 
IX  =  o 

DO  450  1=1 ,H 

DO  490  J=1,N 

IX  =  IX  +1 
Atl.J)  =  BUFFCIX) 

490  CCNTIMJE 
SO  TO  900 
475  CONTINUE 
K2  =  *M( 

CALL  CBUFFRU.Ka.M.N.BUFF) 

C 

900  CONTINUE 
C 

1000  CONTINUE 
RETURN 
DC 


READMX 

00117 

READMX 

00116 

READMX 

00119 

REAOMX 

00120 

READMX 

00121 

READMX 

00122 

READMX 

00123 

READMX 

00124 

READMX 

00125 

READMX 

00126 

READMX 

00127 

READMX 

00128 

REAOMX 

00129 

READMX 

00130 

READMX 

00131 

READMX 

00132 

READMX 

00133 

READMX 

00134 

READMX 

00135 

READMX 

00136 

READMX 

00137 

READMX 

00138 

READMX 

00139 

READMX 

00140 

READMX 

00141 

READMX 

00142 

READMX 

00143 

READMX 

00144 

READMX 

00145 

READMX 

00146 

READMX 

00147 

READMX 

00148 

READMX 

00149 

READMX 

00150 

4 


i 

tl 


c 

c 

c 


N,.gn>, 

DJICNSION  A(K2>1)  >BUFF(d 


PW1  A  CCH^«  ARRAY  ST«ED 

IX  s  0 
*<  =  HfH-I 


buff  two  fcrtran  array-  a 


DO  100  1=1 ,  MN,2 
DO  100  j=i,N 
IX  =  Ik  M 
I1*  =  1X2  ♦  i 
AHiJ)  =  BUFrctX) 
A»IM,J>  =  B  CAT  (1X2) 

too  ccwiNue 
RETURN 
EH) 


READMX  00151 
READNX  00152 
READNX  00153 
READMX  00154 
READMX  00155 
READHX  00156 
READMX  001 5T 
READMX  00158 
READMX  00159 
READMX  00160 
READMX  00161 
READMX  00162 
READMX  00163 
READMX  00164 
READMX  00165 
READMX  00166 
READMX  00167 


B12 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


SUBROUTPC  VRTEMXUOUTFL,  MXVRIT,  RANDOU,  NFS,  N«,  LS,  NR,  LWS, 

VRTEMX 

00002 

1  K,  10,  A,  I TYPE,  M,  N,  PARM,  IRR  ) 

VRTEMX 

00003 

VRTEMX 

00004 

RQUT1VC  TOVRITE  A  MATRIX  ON  TAPE  CR  BISK  FILE. 

VRTEMX 

00005 

TV) IS  VERSION  WALL  CK.Y  WORK  WITH  SEQICNTIAL  FILES. 

VRTEMX 

00006 

SOME  VARIABLES  ARE  PASSED  FOR  RANDOM  OPERATION  BUT 

VRTEMX 

00007 

are  not  currently  uses. 

VRTEMX 

00008 

VRTEMX 

00009 

IOUTFL 

-  TAPE  NUVRER  CR  LEFT- JUST I FI  ED  FILE  NAME 

VRTEMX 

00010 

MXVRIT 

-  .T.  SHARK  FORMAT  (NOT  USED) 

VRTEMX 

00011 

.F.  TEL001  FORMAT  (NOT  USED). 

VRTEMX 

00012 

RANXU 

-  .T.  RAPCCM  FILE  (NOT  USED) 

VRTEMX 

00013 

.F.  SEQUENTIAL  RLE  (NOT  USED) 

VRTEMX 

00014 

»n 

-  NUPCER  OF  FILES  TO  SPACE  <SEB.  CM.Y) 

VRTEMX 

00015 

-  NUA6ER  OF  MATRICES  TO  SPACE 

VRTEMX 

00016 

LS 

-  LEVEL  NUMBER  TO  SPACE  (NOT  USED  ) 

VRTEMX 

00017 

NR 

-  IDENTIFIER  (NAME  OR  NUMBER)  (NOT  USED  ) 

VRTEMX 

00018 

LWS 

-  LEVEL  NUMBER  CF  THIS  MATRIX  (NOT  USED  ) 

VRTEMX 

00019 

K 

-  ROW  DIMENSION  CF  A 

VRTEMX 

00020 

-  (IF  0,  MATRIX  IS  ALREADY  IN  /RVRlFE/  ) 

VRTEMX 

00021 

ID 

-  ARRAY  CONTAINING  MATRIX  NAME 

VRTEMX 

00022 

A 

-  ARRAY  CONTAINING  MATRIX 

VRTEMX 

00023 

I  TYPE 

-  REAL, DIAGONAL. NULL, NIXED, CCMFLEX 

VRTEMX 

00024 

N 

-  ROW  DIMENSION  OF  MATRIX 

VRTEMX 

00025 

N 

-  COLUMN  BIMEA6ICN  CF  MATRIX 

VRTEMX 

00026 

FARM 

-  10  VXRO  PARAMETER  ARRAY 

VRTEMX 

00027 

IRR 

-  ERROR  RETURN 

VRTEMX 

00028 

s  0.  NO  ERROR 

VRTEMX 

00029 

1.  MATRIX  SPACING  IS  NEGATIVE 

VRTEMX 

00030 

2,  FILE  SPACING  IS  ACGATIVE 

VRTEMX 

00031 

4,  MAN  DIMENSIONS  ARE  M.  IBGCNT 

VRTEMX 

00032 

1500  ♦  I.  ENCOUNTERED  EOF  AFTER  MATRIX  1/2  LHILE 

VRTEMX 

00033 

SKIPPING  MATRICES. 

VRTEMX 

00034 

VRTEMX 

00035 

VRTEMX 

00036 

DI»CN5IOM 

IB(1) ,  A 00,1 ) ,  PARM(IO) ,  B(16) 

VRTEMX 

00037 

DIMENSION 

IB  (16) 

VRTEMX 

00038 

BBUI VALENCE  (B, IB) 

VRTEMX 

00039 

LOCI  CAL 

MXVRIT, RANXXI 

VRTEMX 

00040 

VRTEMX 

00041 

COMON  /RVCUFF/  BFCCCE.IBFCNT,  8UFF(3280) 

VRTEMX 

00042 

DATA 

BFCCCE.IBFCNT  /SHBUFFSIZE,  3280  / 

VRTEMX 

00043 

VRTEMX 

00044 

VRTEMX 

00045 

TEST  FOR  PROPER  SIZE 

VRTEMX 

00046 

VRTEMX 

00047 

ISIZ  «  NAN 

VRTEMX 

00048 

IF(ITYPE.EB.THCOHPLEX)  ISIZ  =  ISIZ+ISIZ 

VRVZMX 

00049 

irasiZ.LE.lBFCNT)  CO  TO  205 

VRTEMX 

00050 

IRR  •  4 

VRTEMX 

00051 

CO  TO  1000 
209  CONTINUE 

ir«.LC.o>  co  to  soo 

IF(K.CE.K)  CO  TO  210 
IRA  *  9 
CO  TO  1000 


VRTEMX 

VRTEMX 

VRTEMX 

VRTEMX 

VRTEMX 

VRTEMX 

VRTEMX 


00052 

00053 

00054 

00055 

00056 

G0057 

00058 


B13 


WWW 


210  CONTINUE 

to  FILE  SPACING 

IF(NFf)  213,230,220 
213  CONTINUE 
IRR  =  2 
CO  TO  1000 

220  CONTINUE 
00  225  1=1, 

222  CONTINUE 

BUFFER  IN  UOUTFL.l)  (BUFF(l)  ,EUFF(IBFCNT>) 

221  CONTINUE 

IFIUWT.iaUTFL)  221,222,225 

223  CONTINUE 
230  CONTINUE 

C 

C  DO  MATRIX  SPACING 

C 

IF(M6)  235,250,240 
235  CONTINUE 
IHR  =  1 
CO  TO  1000 

240  CONTINUE 

WC  =  W6  ♦  M4S 
DO  245  1=1,  WC 

BUFFER  IN  CIOUTn.,1)  {BUFF{l),BUFF<IBFCNm 

241  CONTINUE 

IF  (UNIT.IOUTFL)  241,242,243 

242  CONTINUE 
CO  TO  243 

243  CONTINUE 

IRR  =  1500  ♦  (1*1  )/2 
CO  TO  1000 
243  CONTINUE 
230  CONTINUE 
C 

C  CREATE  B  HEADER  RECOiD 

C 

300  CONTINUE 

IB<1>  =  IDt2) 

IB  (2)  =  M 
IBC3)  =  N 
B14>  =  0 
IB  (5)  =  0 
!B«>  =  ISIZ 
DO  325  1=7,16 
BCD  =  PARNII-6! 

323  CONTINUE 
C 

IFW.LE.O)  CO  TO  400 
C 

C  PUT  ARRAY  A  INTO  BUFFER 

C 

lF(lTYPE.Ca,7WCCMPLEX>  CO  TO  373 
C 

C  NOT  COMPLEX  PUT  INTO  BUFFER, 


VRTEMX 

00039 

VRTEMX 

00060 

VRTEMX 

00061 

VRTEMX 

00062 

VRTEMX 

00063 

VRTEMX 

00064 

VRTEMX 

00063 

VRTEMX 

00066 

VRTEMX 

00067 

VRTEMX 

00068 

VRTEMX 

00069 

VRTEMX 

00070 

VRTEMX 

00071 

VRTEMX 

00072 

VRTEMX 

00073 

VRTEMX 

00074 

VRTEMX 

00075 

VRTEMX 

00076 

VRTEMX 

00077 

VRTEMX 

00078 

VRTEMX 

00079 

VRTEMX 

00060 

VRTEMX 

00081 

VRTEMX 

00082 

VRTEMX 

00083 

VRTEMX 

00084 

VRTEMX 

□0085 

VRTEMX 

□0086 

VRTEMX 

00087 

VRTEMX 

00088 

VRTEMX 

00089 

VRTEMX 

00090 

VRTEMX 

00091 

VRTEMX 

00092 

VRTEMX 

00093 

VRTEMX 

0CO94 

VRTEMX 

00095 

VRTEMX 

00096 

VRTEMX 

00097 

VRTEMX 

00098 

VRTEMX 

00099 

VRTEMX 

00100 

VRTEMX 

00101 

VRTEMX 

00102 

VRTEMX 

00103 

VRTEMX 

00104 

VRicMX 

00105 

VRTEMX 

00106 

VRTEMX 

00107 

VRTEMX 

00108 

VRTEMX 

00109 

VRTEMX 

D0110 

VRTEMX 

00111 

VRTEKX 

00112 

VRTEMX 

00113 

VRTEMX 

00J14 

VRTEMX 

00115 

B14 


c 

VRTEHX 

00116 

IX  =  0 

VRTEHX 

00117 

DO  3 SO  1=1,  M 

VRTEHX 

00118 

DO  3 SO  J=1,N 

VRTEHX 

00119 

IX  =  IX  ♦  1 

VRTEHX 

00120 

BUFF-(IX)  =  A(I,J> 

VRTEHX 

00121 

3 SO  CONTINUE 

VRTEHX 

00122 

GO  TO  400 

VRTEHX 

00123 

c 

VRTEHX 

00124 

c 

CCMH.EX,  CALL  ROUTINE  TO  STORE  INTO  BUFFER. 

VRTEHX 

00125 

c 

VRTEHX 

00126 

3T5  CONTINUE 

VRTEHX 

09127 

K2  =  K+K 

VRTEHX 

00128 

CALL  CCM5l^(A,K2,M,N,BUfT) 

VRTEHX 

00129 

IX  = 

VRTEHX 

00130 

c 

VRTEHX 

00131 

400  CONTINUE 

VRTEHX 

00132 

c 

VRTEHX 

00133 

c 

VRITE  TOE  B  HEADER  RECORD  AM)  TOE  BUFFER  ARRAY  RECORD 

VRTEHX 

00134 

c 

VRTEHX 

00135 

BUFFER  OUT  (I0UTFL.1)  <B(1),B(16)> 

VRTEHX 

00136 

300  CONTINUE 

VRTEHX 

00137 

IF  (UNIT.IOUTFL)  500,510,510 

VRTEHX 

00138 

510  CONTINUE 

VRTEHX 

00139 

c 

VRTEHX 

00140 

BUFFER  OUT  nCUTFL.l)  <BUFF(1 ) , BUFF (IX) ) 

VRTEHX 

00141 

320  CONTINUE 

VRTEHX 

00142 

IF  (UNIT.IOUTFL)  520,530,530 

VRTEHX 

00143 

330  CONTINUE 

VRTEHX 

00144 

c 

VRTEHX 

00145 

1000  CONTINUE 

VRTEHX 

00146 

RETURN 

VRTEHX 

00147 

EM) 

VRTEHX 

00148 
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sueaa/Tifc  cobufu.ke.m.n.buff) 

DIMENSION  A  (K.2,1)  i BUFF (1) 

PUTS  COMPLEX  ARRAY  A  INTO  BUFFER  BUFF 

IX  =  0 
1X2  =  M*N 
>♦1  =  M*M-1 
DO  100  1st ,*M,2 
DO  100  J=i,N 
IX  =  IX  +  1 
1X2  =  DC  ♦  1 
BUFF(IX)  =  A(I,J) 

BUT«I«)=  A(IM,J) 

100  CONTINUE 
RETURN 
DC 


VRTEMX 

00149 

VRTEMX 

00150 

VRTEMX 

00151 

VRTEMX 

00152 

VRTEMX 

00153 

VRTEMX 

00154 

VRTEMX 

00155 

VRTEMX 

00155 

VRTEMX 

00157 

VRTEMX 

00156 

VRTEMX 

00159 

VRTEMX 

00160 

VRTEMX 

001 61 

VRTEMX 

00162 

VRTEMX 

00163 

VRTEMX 

00164 

VRTEMX 

00165 
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OVERLAY  urveox.l  .1)  DA  TAPP 

PROGRAM  CATAPP  DATAPP 

COMMON  /CCNTRL/  FREVEX.CMACH,  TITLE (8)  i  FRVGEOM.FRVMCeE.DIHW.DIHT,  CCNTRL 
1  DEFAULT  CONTRL 

LOGICAL  FRVGECN.FRVMCCE.DIHW.DIHT, DEFAULT  CONTRL 

COMMON  /FRC8LM/  XMACH  ■  KMCCES ,  NTSLOF  >  MG VALS  ,  SMOOTH ,  NDEG,  CRDFI T ,  PRCELM 

1  EXAICtSUBDVi  PLYWXO  FRC8LM 

LOGICAL  SMOOTH,  CRDFI  T.EXA  I  C.SUBDV,  FLY  WOOD  PRC8LM 

COWON  /FILES  /  NT5,NT6,INTAFE,INFSP,NfLAIC,NSPAIC,NarrP,  FILES 

1  IQJf5P,MCCESC,  I VPSC,  IGE06C, IWTFSC,  IAICSC  FILES 

COWON  /  KERN  /  ERR ,  MXSKRN,  I  FRERN,  NFLKRN,  T6FATK ■  FRCJWEA  KERN 

COWCN  /KVAL  /  IKVAL,  WVAL120) ,  *XS<20>  KVAL 

DIMENSION  )Q(1  (20)  DATAPP 

EQUI  VALENCE  OKl.WVAL)  DATAPP 

COWCN  /IOCCNT/  OfLAICiC6PAICiWTGECM,WrGNAF,WTSL,WrBL,FRBOXt  IOCONT 

1  FRPAIC.FRSAIC.FRMCCS.FRCCEF.FRDW.FRSW.FRVP,  IOCCNT 

2  FRBL,FRDCP,FRGNAF,FRGNAC,FRSL,FRLW,FRN«f,FRCM  BCSFRB 

EBUI  VALENCE  (FRUW.PRDW)  IOCCNT 

LOGICAL  OFLAIC,C6PAIC,WTGECM,WTGNAF,WTSL,WTBL,  FRBOX,  FRPAIC,  IOCCNT 

1  PRSAIC,PRMCCS,FRCOEF,fRDW,FRSW,FRVP,PRBL,FRSL,FRCNAF,  IOCCNT 

2  FRDCP,  FRGNAC,  FRUW,  FRLW,  FRNW,  PR  CM  BCSFRB 

COWCN  /  MODES/  SYM.SYMT.HTYPEW.MTYPET  MODCCM 

COWCN  /CECMTY/  COPLAN,  N5UBDV,  XSUBDV,  NSUBC2.NSUBCN,  NSURF,  GECMTY 

1  Bl, BIBETA, BIS, BIBTAS.VLAX.VLAZ.PSIW,  GECMTY 

2  MXBW,MJ®BW,MfBW,MYBBW,MXBSW,MrBSW,MYBBSW,  GECMTY 

3  1X8W,  XCENTR  GECMTY 

LOGICAL  COPLAN  GECMTY 

COMMON  /SAMPLU'  ISMPLW, ICHCRD (10)  ,  IBGXF(IO) ,  IBOXL  (10)  ,2L0C(10)  SAMFLW 

COWON  /CHECXFR/  DF=PCFR, CEOCFR.MCCCFR , AICCFR . 7MSCFR .SMCfR . CAFCFR  CHECK FR 

LOGICAL  CPFCFR,  GEOCPR,  MCCCPR,  AICCPR ,  f*6CFR ,  SMCFR,  CAFCFR  CHECK  FR 

EQUIVALENCE  TCHECKFR.DFPCFR)  DATAPP 

LOGICAL  CHECK  FR  DATAPP 

COWON  /ARRAYS/  KBXCDW,LBXCDW,LBOSCC,KBXCDT,LBXCDT,KJALFH,LJALFH,  ARRAYS 

1  KALFHA,KKERNL,LKERN-,KPNTRM,LFNTRM,KCEFSL,KELFHI,  arrays 

2  LMCCES.KFNTSD.LPNTSD.KSCW.LSCW.KPNTCW.LPNTCW,  arrays 

3  KDW.LCW.KTVP.LTVP  ARRAYS 

LOGICAL  HXLRIT.RAPCCU.MWEAD.RAFCIN  FTNX1 

INTEGER  QAIC,  OSAIC  FTNX1 

EQUIVALENCE  (MACH.  XMACH)  DATAPP 

REAL  MACH  DATAPP 

DATA  EXEC  /1CHAFMB0X  EXC  /  FTNX1 

NAMELIST  /CARDS  /  XFVkCH  DATAPP 

NA»€Lr5T  /CAR DC  /  DEFAULT,  FRYGECM,FRVWOCEiSYM,MTY PEW,  KIYPET,  DATAPP 

t  NSLKF.CIHW.DIHT,  ISMPLW, WTGNAF.WTBL,  DATAPP 

2  FRCNAF.FRBL.PRSL, FRPAIC, FRSAIC.FRCCEF.FRMCCS,  DATAPP 

X  FRDCF, FRGNAC,  PRLW,  PR  NW,  FRUW,  FRCM,  BCSFRB 

3  FRBOK.PRDW.FRSW.FRVP.SUBDV.EXAIC,  SMOOTH,  NDEG,  DATAPP 

4  DPPC35,C€0CFR,M0C<fR, AICCFR, NWSCPR, SMCFR, CAFCFR,  DATAPP 

3  M?OMEA,CRDFIT,PLYWXC  DATAPP 

NAMELIST  /CARDD  /  OAIC, NAIC, OSAIC, NSAIC, INTAPE, NOUTP, INFSP, ICUFSP  DATAPP 
NAMELIST  /CARDE  /  MCI , WS,  WVAL  DATAPP 

MXUtlT  *  .FALSE.  DATAPP 

RAWOU  *  .FALSE.  DATAPP 

MWEAD  *  .FALSE.  DATAPP 

RAFCIM  =  .FALSE.  DATAPP 

IF  (PREVEX. E9. EXEC)  CO  TO  200  DATAPP 

CMACH  s  0.0  DATAPP 


00002 

00003 

00002 

00003 

00004 

00002 

00003 

00004 

00002 

00003 

00002 

00002 

00009 

00010 

00002 

00003 

00001 

00005 

00006 

0000/ 

00002 

00002 

00002 

00003 

00004 

00005 

00006 

00002 

00002 

00003 

00016 

00017 

00002 

00003 

00004 

00005 

00005 

00006 

00020 

00021 

00007 

00022 

00023 

00024 

00025 

00003 

00027 

OOOHd 

00029 

00030 

00032 

00033 

00034 

00031 

00036 

00037 

00038 
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c 

C  SET  CCNTRCL  PARAMETERS  TO  DEFAULT 

default  =  .false. 

100  CONTINUE 

IRVCCCM  =  .FALSE. 

mvMcoE  =  .false. 

STM  =  1.0 
NTT  PEW  =  2 
NTT  PET  =  2 
WURF  =  1 
OIHW  =  .TRUE. 

DIHT  =  .TRUE. 

ISMFLW  =  0 
WTCNAF  =  .TRUE. 

wtbl  =  .false. 

fRGNAF  =  .TRUE. 

fRBL  =  .false, 
bwl  =  .false, 
prpaic  =  .false. 

fRSAIC  =  .FALSE. 
fRCOEF  =  .false. 
fRMOCS  =  .false, 
ribck  =  .false, 
prcw  =  .FALSE. 
trsw  =  .false. 

fRDCP  =  .FALSE. 

RRCNAC  =  .FALSE. 

TRLW  =  .FALSE. 

IRNM  =  .FALSE. 

PRUW  =  .FALSE. 

*rvp  =  .False. 

TRCM  =  .FALSE. 

SUBDV  =  .FALSE. 

EXAIC  =  .FALSE. 

SMOOTH  =  .FALSE. 

CRDFTT  =  .FALSE. 

M5E6  =  0 
MRCWEA  =  0 
M.YWOOO  =  .FALSE. 

DPPCfR  =  .FALSE. 

CEOCfR  =  .FALSE. 

NODCPR  =  .FALSE. 

AICCTR  =  .FALSE. 

M*CPR  =  .FALSE. 

SMC  PR  =  .FALSE. 

CAFCPR  =  .FALSE. 

PREVEX  =  EXEC 
IF  (DEFAULT)  400, 30G 
200  CONTINUE 

CMACH  =  XWOt 
300  CONTINUE 

READ  (NT5.9005)  TITLE 
9005  FORMAT  C8A10) 

READ(NT5,CARCB) 

IF(XMACH.CT.l .0)  DO  TO  310 
W?ITE  <NT6,8005)  XMACH 
CAU  FLUSH  (t) 


DATAPP  00039 

OPTIONS  DATAPP  00040 

DATAPP  00041 
DATAPP  00042 
DATAPP  00043 
DATAPP  00044 
DATAPP  00045 
DATAPP  00046 
DATAPP  00047 
DATAPP  00048 
DATAPP  00049 
DATAPP  00050 
DATAPP  00051 
DATAPP  00052 
DATAPP  00053 
DATAPP  00054 
DATAPP  00055 
DATAPP  00056 
DATAPP  00057 
DATAPP  00058 
DATAPP  00059 
DATAPP  00060 
DATAPP  00061 
DATAPP  00062 
DATAPP  00063 
DATAPP  00064 
DATAPP  00065 
DATAPP  00066 
DATAPP  00067 
DATAPP  00068 
DATAPP  00069 
BCSFRB  00004 
DATAPP  00070 
DATAPP  00071 
DATAPP  00072 
DATAPP  00073 
DATAPP  OG074 
DATAPP  00075 
DATAPP  00076 
DATAPP  00077 
DATAPP  00078 
DATAPP  00079 
DATAPP  0GG80 
DATAPP  00081 
DATAPP  00082 
DATAPP  00083 
DATAPP  00084 
DATAPP  00085 
DATAPP  00086 
DATAPP  00087 
DATAPP  00088 
DATAPP  00089 
DATAPP  00090 
DATAPP  00091 
DATAPP  00092 
DATAPP  00093 
DATAPP  0009' 


310  continue 

if<xmach.ce.i.2>  oo  to  320 

WJITE  (NT6,801Q) 

CO  TO  350 
320  CONTINUE 

if<xmach.le.3.0)  oo  to  350 


:  MACH  NO.  CHEATER  THAN  3.0 

IF(XmCH.LT.5.Q)  GO  TO  340 
WIITE  (NT6.8015)  XMACH 
CALL  FLUSH  (1) 

340  CONTINUE 

VfllTE  (NT 6, 8020) 

350  CONTINUE 

8005  FORMAT  (52HG***  MACH  NU>«ER  OF  LESS  THAN  1.0  CAN  NOT  BE  USED 
1  14HMACH  NUPBER  =  E15.6,  EH  ***  ) 

8010  FORMAT (62K)***  WARNING  —  MACH  NLACER  LESS  THAN  1.2  IS  BEING  USED. 


DATAPP 
DA  TAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 
DATAPP 


1  ***  ) 

DATAPP 

8015  F<3<MAT<43H0  ***  MACH  NUKJER  GREATER  THAN  5.0.  XMACH  = 

E15.6,  DATAPP 

1  25H  PROGRAM  TERMINATED.  ***  ) 

DATAPP 

8020  FORMAT (64H0***  WARNING  —  MACH  NOCER  GREATER  THAN  3 

.0  IS  BEING  US  DATAPP 

1ED.  ***  ) 

DATAPP 

READ  (NTS, CAR DC) 

DATAPP 

IF(SUBDV)  500,510 

DATAPP 

500  NSUBDV  =3 

DATAPP 

GO  TO  515 

DATAPP 

510  P6UBCV  =1 

DATAPP 

515  CONTINUE 

DATAPP 

DATAPP 

IF<DEFAULT)  100,400 

DATAPP 

DATAPP 

CARD  D 

DATAPP 

400  CONTINUE 

DATAPP 

OAIC  =  0 

DATAPP 

NAIC  =  0 

DATAPP 

C6AIC  =  0 

DATAPP 

NBAIC  =  0 

DATAPP 

INTAPE  =  0 

DATAPP 

H3UTP  =  1 

DATAPP 

i»rsp  =  o 

DATAPP 

IOUFSP  =  0 

DATAPP 

READ  (NTS.CARDC) 

DATAPP 

DATAPP 

IF<QA!C.EB.0>  CO  TO  520 

DATAPP 

WLAIC  =  OAIC 

DATAPP 

QPLAIC  =  .TRUE. 

DATAPP 

CO  TO  530 

DATAPP 

520  CONTINUE 

DATAPP 

WLAIC  a  0 

DATAPP 

OPLAIC  a  .FALSE. 

DATAPP 

530  CONTINUE 

DATAPP 

iF<mtc.Ea.o>  co  to  540 

DATAPP 

WLAIC  a  MAIC 

DATAPP 

oplaic  a  .false. 

DATAPP 

540  CONTINUE 

DATAPP 

DATAPP 

CETERMI1C  OPTIONS  CF  SPATIAL  XERfCLS 

DATAPP 

00095 

00096 

00097 

00098 

00099 

00100 

00101 

00102 

00103 

00104 

00105 

00106 

00107 

00108 

00109 

00110 

00111 

00112 

00113 

00114 

00115 

00116 

00117 

00118 

00119 

00120 

00121 

00122 

00123 

00124 

00125 

00126 

00127 

00128 

00129 

00130 

00131 

00132 

00133 

00134 

00135 

00136 

00137 

00138 

00139 

00140 

00141 

00142 

00143 

00144 

00145 

00146 

00147 

00148 

00149 

00150 

00151 
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IF(C6AIC.ER.0)  CO  TO  560 
WPAIC  =  06AIC 
0»PAIC  =  .TRUE. 

50  TO  5  TO 
560  CONTINUE 
MSPAIC  s  0 
C8PAIC  =  .FALSE. 

570  CONTINUE 

IF(NSAIC.BB.O)  CO  TO  500 
N5PAIC  =  NSAIC 
CBPAIC  =  .FALSE, 
sec  CONTINUE 

c 

IF  (NOUTP.TE.O)  CO  TO  GOO 
IFIWTCNAF)  WilTE  (NT6.9041) 

IFCWTBL  )  WRITE  (NT6.9042) 

WTCNAF  =  .false. 

WTBL  =  .FALSE. 

600  CONTINUE 
C  CARD  E 

DO  610  1=1,20 
J*S(I)  =  -1. 

MU  (I)  =  -1. 

610  CCNTIMJE 

READ  (NTS,  CAR  CO 
DO  620  1=1,20 

lFO*S(I).tC.-1.0.CR  .MU(t).)C.-l.Q)  CO  TO  620 
NIVALS  =  1-1 
CO  TO  625 
620  CONTINUE 
N1VALS  =  20 
623  CONTINUE 
C 

(RITE  (NTS, 9303) 

MUTE  (NTS. 9501) 

WIITE  (NT6.9551)  TITLE 
WIITE  (NT6,95flO)  XMACH 
IF(DEFAULT)  WIITE  (NT6.9575) 

IFtSYM.EQ.1 .0)  WIITE  (NT6.9552) 
lF(SYH.Ea.-l.)  WIITE  (NT6.9553) 

IF  (PLYW3X)  WIITE  (NT6.9554) 

IF  (DPPCPR.AW3. PLYWOOD)  WIITE  <NT6,9558) 

IF(.NOT.SUBDV)  WIITE  (NT6.9572) 

IF(SU6CV)  WIITE  (NT6.95T3) 

IF  (SU6DV  .AW).  NROWEA  .7C.  0)  WIITE  (NT6.9546)  WIOUEA 
iF(NSLRF.Ba.i)  WIITE(NT6,9556) 

IF(NMjRF.E8.2)  WIITE(NT6,9557) 

IF(.NOT.EXAIC)  WRITE  (NT6.95T6) 
ir(EXAIC)  WIITE  (NT6,9577) 

IF(CRDFIT)  SMOOTH  =  .FALSE. 

IF  (SMOOTH)  WRITE  (NT6.9581)  W!E& 

IF(CROFIT)  WIITE  (NT6.9585)  NDEC 

IF  (.NCX.  (SMOOTH  .CR.  CRDFIT)  .OR.  W)EC  .LE.  10)  CO  TO  630 
W)EC  *  10 

WIITE  (NT6.9043)  W)EC 
630  CONTINUE 

IF(PRBOX)  WIITE  (NT6.9569) 


DATAPP  00152 
DATAPP  00153 
DATAPP  00154 
DATAPP  00155 
DATAPP  00156 
DATAPP  00157 
DATAPP  00158 
DATAPP  00159 
DATAPP  00160 
DATAPP  00161 
DATAPP  00162 
DATAPP  00163 
DATAPP  00164 
DATAPP  00165 
DATAPP  00166 
DATAPP  00167 
DATAPP  00168 
DATAPP  00169 
DATAPP  00170 
DATAPP  00171 
DATAPP  00172 
DATAPP  00173 
DATAPP  00174 
DATAPP  00175 
DATAPP  00176 
DATAPP  00177 
DATAPP  00178 
DATAPP  0017c 
DATAPP  00180 
DATAPP  00181 
DATAPP  00182 
DATAPP  00183 
DATAPP  00184 
DATAPP  00185 
DATAPP  00186 
DATAPP  00187 
DATAPP  00188 
DATAPP  00189 
DATAPP  00190 
DATAPP  00191 
DATAPP  CO  192 
DATAPP  00193 
DATAPP  00194 
DATAPP  00195 
DATAPP  00196 
DATAPP  00197 
DATAPP  00198 
DATAPP  00199 
DATAPP  00200 
DATAPP  00201 
DATAPP  00202 
DATAPP  00203 
DATAPP  00204 
DATAPP  00205 
DATAPP  00206 
DATAPP  00207 
DATAPP  00208 
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IF(PRCOEF)  VR1  TE  <NT6,9582> 

IF(PRHCCS)  VRITE  (NT6.9568) 

IF(FRPAIC>  VRITE  <NT6,9583> 

IF(PRSAIC)  VRITE  (NT6.9584) 

IF(RRCW)  VRITE  (NT6,9570) 

lF<f*sw)  VRITE  <NT6,9578> 

IF  (FRLW)  VRITE  (NT6.9544) 

IF  (FRNW)  VRITE  <NT6,9545> 

iF(fRVP)  VRITE  (NT6.957I) 

IF(FRBL)  VRITE  <NT6,9565> 

IF(PRSL)  VRITE  (MT6.9566) 

IFIPRCM)  VRITE  <NT6,956r> 

iF(frkp)  vrite  <nt6,9542> 

IF(FRGNAC)  VRITE  (NT6.9543) 

IF(PRGNAF)  VRITE  <NT6,9564> 

IF (VTBO  VRITE  <NT6,9562> 

IF(WTON*n  VRITE  (NT6.9561) 

IFIFRVGEOO  VRITE  <NT6,9531> 

IFIPRVHCCO  VRITE  (NT6.9532) 

IF(HTYFEV4.EQ.1)VRITE  (NT6.9533) 

IF(KTTFEU.EQ.2)VRITE  (NT6.9534) 
lF<KTYP€W.Ea.3)VRITE  <NT6,9535) 

IF(NSURF.EB.l)  CO  TO  650 
IF  (MTY  PET. EQ.1)  VRITE  <NT6,9536> 

I F  (MTY  PET.  BJ.  2)  VRITE  (NT6.9537) 

IF(MTYFET.EB.3>VRITE  (NTS, 9538! 

680  CCNTINJE 

iFfDIHV*  VRITE  (NT6.9539) 

IF  <N5URF.Ett.l)  CO  TO  660 
IF(DIHT)  VRITE  (NT6.9540) 

660  CONTINUE 
ERR  =  0.01 

IF(EXAIC)  ERR  =  0.0001 
C 

C  THIS  SET  OF  VARIABLES  ARE  DIMENSION  SIZES  FCR  ARRAYS. 

C  THE  NLM3ER  IS  THE  DIMEF6I0N  OF  THE  ARRAY. 

C  FOR  DOUBLE  DIMENSIONS  ARRAYS  IT  IS  THE  LARGEST  NLHDER, 

C  NOT  THE  PRODUCT  OF  THE  TWO  DIMENSIONS. 

C 

KKERK.  =  1 
LKERNL  s  1640 
LBNCCW  s  150 
LBXCDT  =  SO 
USOKC  =  8 

UALFH  =200 
LPNTRM  =  100 
LMCCE5  =  1000 
LPNTSD  =90 
L4DW  =600 
LPNTDW  =  100 
LDW  a  12?5 
LTVP  =250 
C 

VRITE  <NT6,6001) 

VRITE  (NTS, 6002)  QAIC,HAIC,OSAIC.NSAIC,INTAPE,INFSP,NOUTP,IOUFSP 
C 

6001  FCRHATMH0/45X,  39HTHE  FCUCWINC  TAPE  SETUP  IS  REQUESTED  -  /> 


DATAPP  00209 
DATAPP  OC210 
DATAPP  00211 
DATAPP  00212 
DATAPP  00213 
DATAPP  00214 
DATAPP  00213 
DATAPP  00216 
DATAPP  00217 
DATAPP  00218 
DATAPP  00219 
BCSFRB  00005 
DATAPP  00220 
DATAPP  00221 
DATAPP  00222 
DATAPP  00223 
DATAPP  00224 
DATAPP  00225 
DATAPP  00226 
DATAPP  00227 
DATAPP  00228 
DATAPP  00229 
DATAPP  00230 
DATAPP  00231 
DATAPP  00232 
DATAPP  00233 
DATAPP  00234 
DATAPP  00235 
DATAPP  00236 
DATAPP  00237 
DATAPP  00238 
DATAPP  00239 
DATAPP  00240 
DATAPP  00241 
DATAPP  00242 
DATAPP  00243 
DATAPP  00244 
DATAPP  00245 
DATAPP  00246 
DATAPP  00247 
DATAPP  00248 
DATAPP  00249 
DATAPP  00250 
DATAPP  00251 
DATAPP  00252 
DATAPP  00253 
DATAPP  00254 
DATAPP  00255 
DATAPP  00256 
DATAPP  00257 
DATAPP  00258 
DATAPP  00259 
DATAPP  00260 
DATAPP  00261 
DATAPP  00262 
DATAPP  00263 
DATAPP  00264 
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6002  FORMAT  <51  X,*CLD  AIC  TAPE  =*, I3./51X, *NEW  AIC  TAPE  =*,I3,/  DATAPP 

1  51X,*CLD  SPATIAL  AIC  TAPE  =*,  13 ,/51  X,*NEW  SPATIAL  AIC  TAPE  =*,I3,  DATAPP 

2  /  SIX, ♦INPUT  DATA  TAPE  =*,I3,*  SPACED*,  13,*  FILES,*  DATAPP 

3  /  31X,*CUTPUT  TAPE  =*,I3,*  SPACED*, 13,*  FILES,*  //)  DATAPP 

C  DATAPP 

C  PRINT  THE  WVAL  CR  *XS  ARRAY.  DATAPP 

C  DATAPP 

IFOOa(i).EB.-l.O)  CO  TO  TOO  DATAPP 

W5ITE  (NT6, 6003)  DATAPP 

W?ITE<NT6, 6004)  (W1  <1 )  ,1=1  .NKVALS)  DATAPP 

CO  TO  900  DATAPP 

C  DATAPP 

TOO  CONTINUE  DATAPP 

IFO*S<l>.EB.-t.O)  CO  TO  800  DATAPP 

VRITE  (NTS,  6005)  DATAPP 

V#?ITE(NT6, 6004)  OfcS<I),I=t,N<VAL$>  DATAPP 

CO  TO  900  DATAPP 

C  DATAPP 

800  CONTINUE  DATAPP 

VRITE(NT6, 6006)  DATAPP 

C  DATAPP 

900  CONTINUE  DATAPP 

C  DATAPP 

6003  FORMAT (1HD.29X,  *THE  FOLLOWING  IS  THE  REDUCED  FREQUENCY  ARRAY  BASE  DATAPP 

ID  ON  BOX  LENGTH*  /)  DATAPP 

6005  FORMAT  <1HD,29X,  *THE  FCLLCWINC  IS  THE  REDUCED  FREQUENCY  ARRAY  BASE  DATAPP 

ID  ON  WING  SEMI -SPAN*  /)  DATAPP 

6004  FORMAT (1H  /  01X.6F11.5)  )  DATAPP 

6006  FORMAT (49H0***  WARNING  —  NO  REDUCED  FREQUENCIES  SPECIFIED.  DATAPP 

1  51H  fROCRAM  WILL  TERMINATE  AFTER  GEOMETRY  SECTION  ***  )  DATAPP 

C  DATAPP 

C  DATAPP 

1000  RETURN  DATAPP 

9900  FORMAT (1H1 ,29X,  58  <1H*)  ,/30X,lH*>  56X,  1H*,/30X,58H*  UNSTEADY  AE  DATAPP 

1R0CYNAMICS  OF  WING-HORIZONTAL  TAIL  *,/30X,lH*,12X,*CCAFIGURATI  DATAPP 
20NS  IN  SUPERSONIC  FLCW*11  X,  tH*,/30X,lH*,56X,lH*,/30X,  58H*  PREP  DATAFP 
3ARED  (ACER  CONTRACT  NO.  AF  3361 5-70-C-U26  *,/30X,  1H*,20X,  *FRO  DATAPP 

4JBCT  NO.  1370*.  20X,1H*,/30X,1H*,  56X,  1H*  )  DATAPP 

9901  FOJMATC50X,1H*,5X,*FCR  DEPARTMENT  OF  THE  AIR  FORCE*,  19X,  1H*.  /  DATAFP 

1  30X,1H*,10X,*AERONAUTICAL  SYSTEMS  DIVISION*,  17X,1H*,  /  DATAPP 

2  30X,1H*,10X,*AIR  FCRCE  FLIGHT  CTWMICS  LABCRATCRY*.  10X,  1H*.  /  DATAFP 

3  30X,1H*,10X,**4<IGHT- FATTER  SON  AIR  FORCE  BASE*,15X,1H*.  /  DATAPP 

4  30X,1H*>  56X,  1H*,  /  DATAPP 

3  30X,1H*,5X,*8Y  THE  BOEING  CCMFAWf *,28X, !H*,  /  DATAPP 

•  30X,1H*.10X,*CC**IERCIAL  AIRPLAY  DIVISION*,  18X.1H*.  /  DATAPP 

T  30X,  1H*«  10X, *SEATTLE,  WASH  I  NOT  Of**,  27X.1H*,  /  DATAPP 

8  30X,1H*.56X,1H*,/  SOX,  58  <1H*> ,/  )  DATAPP 

9041  FORMAT <72H0***  WARNING  --  NO  OUTPUT  TAPE  WAS  REQUESTED  FOR  GENERAL  DATAPP 

II ZED  FORCES.  ***  )  DATAPP 

9042  FORMAT (63H0***  WARNING  —  NO  OUTPUT  TAPE  WAS  REQUESTED  FOR  BOX  LIF  DATAPP 

ITS.  ***  >  DATAPP 

9043  FORMAT (54H0***  WARNING  —  ORDER  FOR  VELOCITY  POTENTIAL  SMOOTHING  DATAPP 

1  36H  TOO  LARGE.  IT  HAS  BEEN  REDUCED  TO  ,12,  4H  ***)  DATAPP 

9551  FORMAT (1H0,5X,7HTITLE  -,I3X,8A10,13X,7H-  TITLE  /1H0/45X,  DATAPP 

I  37HTHE  FCLLCWI NG  OPTIONS  ARE  REQUESTED  -  /  >  DATAPP 

9531  FORMAT <51  X,*C€CWETRY  FROM  PREVIOUS  CYCLE*  )  DATAPP 

9532  FORMAT  <51  X,*MCCE  SHAPES  FROM  PREVIOUS  CYCLE*  )  DATAPP 
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9533  FCRMAT  (51  X,*MOCAL  INPUT  FCR  WING  IS  POLYNOMIAL  COEFFICIENTS*  ) 

9534  FCRMAT (51  X, *MCCAL  INPUT  FCR  WING  IS  ARBITRARY  LOCATIONS  FCR  SURFAC 
IE  FITTING  *  ) 

9535  FCRMAT  (51  X,*MCCAL  INPUT  FCR  WING  1^  BOX  CENTER  VALUES*  ) 

9536  FCRMAT  (51  X,*MCCAL  INPUT  FCR  TAIL  IS  POLYNOMIAL  COEFFICIENTS*  ) 

9537  FCRMAT  (51  X,*MCCAL  INPUT  FCR  TAIL  IS  ARBITRARY  LOCATIONS  FCR  SURFAC 

IE  FITTING  *  > 

9538  FCRMAT<51X,*MCCAL  INPUT  FCR  TAIL  IS  BOX  CENTER  VALUES*  > 

9539  FCRMAT (51 X, *DIHEDRAL  WING  IKFLUENCE  CALCULATED*  ) 

9540  FCRMAT  (51  X,*DIHEDRAL  TAIL  INFLUENCE  CALCULATED*  ) 

9342  FCRMAT(51X,*FRINT  PRESSURE  DIFFERENCE  COEFFICIENTS*  ) 

9543  FCRKAT(51Xi*FRINT  GEtCRALlZED  AERCCYNAMIC  COEFFICIENTS*  ) 

9544  FCRMAT(51X,*PRINT  LCNGITUDINU.  WASHES  ALONG  SAMPLING  CHORDS*) 

9545  F<RHAT(51X,*PRINT  NORMAL  WASHES*  > 

9546  FCRMAT <51X,*£FFECTI VE  SUBDIVIDED  AREA  OF*, 13,*  R0W5  REQUESTED*  ) 

9552  FORMAT (51 X, ASYMMETRIC  ANALYSIS*) 

9553  FCRMAT  (51 X,  *A  NT  I -SYMMETRIC  ANALYSIS*) 

9554  FORMAT (51  X,*fUYWOCC  OPTION  IS  USED.  (RJUCCRM  BOUTCARY  DETERMDCD 
1BY  BOX  PATTERN.)  *) 

9556  FCRMAT(51X,*SINGLE  fLAPECRM  ANALYSIS*) 

9557  FCRMAT (51X,  *ANALYSIS  FOR  2  PLANFCRMS*) 

9558  FCRMAT (1H0, 100 (1HS)///*  THE  SfRUCE  GOOSE  IS  L0C6E  *  //1HD, 

1  100  (1HS)  ) 

9561  FCRMAT (51X,*W?ITE  GENERALIZED  AIR  FORCES  ON  TAPE*) 

9562  FORMAT  (51  X,*W?ITE  BOX  LIFTS  ON  TAFE*> 

9564  FCRMAT (51 X,  *fRI  NT  GEfERALIZED  AIR  FORCES*) 

9565  FCRMAT (51X,*FRINT  THE  BOX  LIFTS*) 

9566  FCRMAT (51X, *PRINT  THE  SECTION  LIFTS*) 

9567  FCRMAT (51  X,*SECTION  MOMENTS  WILL  BE  COMPUTED  WITH  MCCE  SHAPE  ONE*/ 
t  SIX,*  ASSUMED  FCR  THE  PITCH  MCCE.*  ) 

9568  FCRMAT (51X,  *FRINT  MCCE  SHAPES  USED*) 

9569  FCRMAT(51X,*FRINT  THE  BOX  FATTER N*) 

9570  FCRMAT(5lX, *PRI NT  THE  UFWASHES  ALONG  SAM(3_ING  CHORDS*) 

9571  FCRMAT(51X,*FRINT  THE  VELOCITY  POTENTIALS*) 

9572  FCRMAT (51 X, *EASIC  (UNSUBDIVIDED)  ANALYSIS  WILL  BE  USED*  ) 

9573  FCRMAT (51  X,*SISDI VISION  WILL  BE  AFfLIED*) 

9575  FCRMAT  (51  X,*ALL  PARAMETERS  SET  TO  *  "FAULT  VALUES*) 

9576  FCRMAT (51  X,*AFEROXI MATE  KERNELS  Win.  BE  USED*) 

9577  FCRMAT (51  X,  *€XACT  KERfCLS  WILL  BE  USED*) 

9578  FCRMAT (51  X,*FRI NT  THE  SIDEVASHES  ALONG  SAMPLING  CHORDS*) 

9580  FORMAT (51  X,*MACH  HLA43ER  =  *,  FB.6) 

9581  FCRMAT (51 X, *VELCCITY  POTENTIALS  WILL  BE  SMOOTHED  BY  A  LEAST-SQUA*. 

1  ARES*  /  61 X, *PCLYNCMlAL  SURFACE  FIT,  OF  ORDER*, 12, 1H./ 

2  61X,*(0  =  PROGRAM  DETERMDCD.)  *  ) 

9582  FCRMAT (51  X,*FRI NT  MCCE  SHAPE  PCLYNCHI Al  COEFFICIENTS,  IF  AVAILAB*, 

1  *LE  *  ) 

9583  FCRMAT (51 X, *PRINT  THE  PUNAR  AIC  ARRAYS  USED  *  ) 

9584  FCRMAT (51  X,*PRI NT  THE  SPATIAL  AIC  ARRAYS  USED  *  ) 

9585  FCRMAT (51 X, *VtLOCITY  POTENTIALS  WILL  BE  SMOOTHED  BY  A  LEAST  SQUA*, 

1  ARES*  /  61X,*PCLYNCMIAL  CHCRDWISE  FIT,  OF  CRCER*,I2,IH./ 

2  6lX,*(0  =  PROGRAM  CETERMIPCD.)  *  ) 

END 
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OVERLAY  (AFveOX.1,2)  CEOBX 

program  ceocx  geopcx 

C  THIS  CVERLAY  READS  ALU  GEOMETRIC  INFORMATION  (CARDS  &  TO  L,  CR  GEORX 

C  FROM  TAPE)  AND  COMPUTES  THE  INTERNAL  GEOMETRY  NEEDED  GEOCX 

C  ERRORS  IN  GEOMETRIC  DEFINITION  ARE  CAUGHT  GEOCX 

C  ALL  GEOMETRY  IS  NON-DIMENSIONAL  I  ZED  BY  BOX  WIDTH  (LENGTH)  GECKSX 

C  BOX  COOES  ARE  DEFINED  -  CEOCX 

C  0  =  NOT  USED  GEOCX 

C  1  =  ON- PLAN7 CRM  GEOCX 

C  2  =  DIAPHRAGM  GEOCX 

C  3  =  WAKE  GEOCX 

C  AL»HA  ARRAY,  FRACTIONAL  PART  CF  EDGE  BOXES,  IS  COMPUTED  GEOCX 

C  MAXIMUM  PLANAR  AIC  ARRAY  SIZE  IS  DETERMINED  GEOCX 

C  PGR  EACH  O40RD  REQUIRING  A  SPATIAL  AIC  ARRAY,  DETERMINE  GEOCX 

C  VHICH  AIC  ARRAY  TO  USE  (KPTWW,  KPTTT ,KFTW5T,DPTW_T)  GEOCX 

C  EL,  THE  VERTICAL  DISTANCE  SEPARATING  THE  SURFACES  GEOCX 

C  YEAR,  THE  HORIZONTAL  OFFSET  GEOCX 

C  MIMIC  ARRAY,  A  MAP  OF  NEEDED  AIC  VALUES  GEOCX 

C  GEOCX 

CXMMQN  /CCNTRL/  PREVEX , CMACH ,  TITLE(8) ,  FRVGECM,  FRVMCCE,  DIHW.DIHT,  CCNTRL 

1  DEFAULT  CCNTRL 

LOGICAL  PRVGECM.PRVHOCE,  DIHW.DIHT,  DEFAULT  CCNTRL 

COWCN  /PRCBLPV  ttMCH ,  PNGCES , NTSLOP,  PKVALS , SMOOTH ,  MEG,  CR DFI T ,  PRCBLM 

1  EXAIC.SUBDV.PLYVOCO  PRCBLM 

LOGICAL  SMOOTH, CRCFIT.EXA I C.SUBDV,  R.YWOCC  PRCBLM 

CCMMCN  /KVAL  /  IKVAL,  *(VAL  (20) ,  WS(20)  KVAL 

COWON  /GEOMTY/  COPLAN, NSUBDV,XSUBDV,NSUBK,NSUBCN,P6LRF,  GECMTY 

1  B1,B1BETA,B1S,B1BTAS,VLAX,W_AZ,PSIW,  GECMTY 

2  NXBW.MXBBW.MYBW.MYBBW.MXBSW.MYBSW.KYBBSW,  GECMTY 

3  IXBW,  XCENTR  GECMTY 

LOGICAL  COPLAN  GECMTY 

COWON  /CEOe  /  TLAX.TLAZ, P>SIT,MXBT,MYBT,MY88T,MX8ST,WfBST ,  GEOC 

1  MTBBST ,  I XBT,  I XBST , CAFL  GECM2 

COWCN  /  KERN  /  EKR,MXSKRN,IFKEKN,NPLKRN,NSPATK,N50WEA  KERN 

COWON  /RUES  /  NTS, NT6, INTAPE, If#SP,NPLAIC,N5PAIC,NCUTF,  FILES 

t  IOUFSP.M0CESC,  i  VFSC,  IGCCSC ,  IWTF$C,  IAICSC  FILES 

COWON  /IOC CNT/  CALAIC ,G6PAIC,WTCCCM, WTGNAF, WTSL I WTBLi FRBOX,  IOCCNT 

1  PR PAIC,  PRSAIC,  PRMOCS,  PRCOEF ,  FRDW,  PRSW,  FRVP,  IOCCNT 

2  PRBL ,  PRDCP,  PRGNAF ,  PRGNAC ,  H5SL ,  FRLW,  PRNW,  PRCM  BCSFRB 

QKII  VALENCE  (PRUW.PRDW)  IOCCNT 

LOGICAL  OPLAIC.OSPAIC.WTGECM.WTGfWF.WTSL.WTBLiPRBOX.FRFAIC,  IOCCNT 

»  PRSAIC,  PRMOCS,  PRCOEF,  PROW,  PRSW,  FRVP,  PRBL ,  FRSL ,  FRGNAF,  IOCCNT 

2  PRDCP,  PRGNAC,  PRUW.PRLW,  PRNW,  PRCM  BCSFRB 

COWON /TAPEICy  PCS,PWS,L$,P*R,ID(20)  ,NID,ITYPE,LRS,LW5,M,N,  TAPEI  / 

t  PARMUOMRR  TAPEIO 

DIMENSION  IPARM(IO)  TAPEIO 

BUI  VALENCE  (FARM,  I  FARM)  TAPEIO 

COWON  /  MODES/  SYM,3YMT,MTYPEW, MTYrt'*  MCDCCM 

COWON  /ARRAYS/  KBXCDW,LBXCDW,LBOXC,',BXCDT,LBXCDT,KJALPH,LJALPH,  ARRAYS 
I  KALPHA,KKEJ5M.,LKEK,4.,KPNTRM,LPNTRM,KDEFSL,KELPHI,  ARRAYS 

*  LMOCES.KPNTSD.LPNTSD.KSDW.LSDW.KPNTDW.LPNTBW,  ARRAYS 

3  KCW.LDW.KTVP.LTVP  ARRAYS 

COWON /SAMPLW/  ISMP»LW,ICHCRD(10) ,  IBOXF(IO) ,  IBOXL  (10)  >ZLOC  (10)  SAMPLW 

COWON  /MIMICS/  YBAR, EL, MUAIC(2, SO), PROWS, SURF,  MUAICS 

|  YBARL.aL,  MUAICL(2,50),PROCL,SURa,PSIDIF  MUAICS 

LO&tCAL  SURF.SURa  MUAICS 

COWON  /ECGES  /  FEXLOC  (250) ,  TEXLOC  (250) ,  JCIAC  EDGES 
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CCMMCN  /PUNXY/  NM.E,MWTE,NTLE:.NTTE,  XW.EUO)  ,YVLE(10)  , 

1  XWTE(10),YWTE(10>,  X'LEUOl.YTLEdO), 

2  XTTECIO)  iYTTE<10) 

LOGICAL  MXVRIT.RANCOU,  MWEAD.RAACIN 

CCMMCN  /CHECKS/  DFPCPR,&EOCPR,MCCCfR,AICCB<,A*6CPR,SMCPR,CAFCFR 
LOGICAL  CPPCFR.  CEOCPR,  MCCCPR,  AICCFR.NWSCPR,  SMCBt,  GAFCPR 
ajUI  VALENCE  (CHECKFR.GEOCFR) 

LOGICAL  CHECK  fR 
C 
C 

DIMEK810N  IBGXWtl  50,8)  , IBOXT (90.8) , 

1  IWWEM60),  ICCCEIieO) 

DIMENSION  KPTWW(50)  ,KPTTT(50)  ,KPTLWT(50>  ,KPTRWT(50> 

DIMEKBICN  ALPHA  (200) ,  I JALRH  (200) 

DIMENSION  KPT <4, 50) 

EQUIVALENCE  <KPT i ALPHA) 

DATA  MXWHT.RAKCOJ.MWEAD.RANCIN  /  4*.F.  / 

DATA  A«W<D  /20/ 

DATA  IWT.XINIT  /  37767CB.  37654321 77777777777TB/ 

DATA  EPS  /  1.0E-4  / 

C 

C  NAMELIST  PARAMETERS  FOR  CARDS  TO  BE  READ  IN  THIS  SECTION 

NAMELIST  /CARCF  /  VLAX.VLA2.PSIW,  TLAX.TLA2.  PSIT,  CHECK  PR 
1  /CARGO  /  NCHRDS,  XCENTR,  WEDGE.  ICHCRC, IBOXF, IB0XL.2L0C 

C  CAR  EH  KALE,  NWTE,  NTLE,  NTTE  (415) 

C  CARDS  I  TOL  (6E10.0) 

C 

aooi  format  <4 1 5) 

3002  F<  RHAT (6C10.0) 


LSCHDS  =  LB  OXC  *  20 
WMJBCV  r  NSUBCV 
NSUBCZ  =  NSUBDV/2 
**UBCN  =  NSU6E2  ♦  1 
HALFBX  =  XSUBDV/2.0 
C 

C  IS  DEVIOUS  CECMETRV  TO  BE  USED  - 

IF  (.NCR.  fRVGCCM)  CO  TO  15 
C  YES.  HAS  THE  MACH  NUMBER  CHANGED  - 

IF  (  XMACH  .EQ.  CMACH)  GO  TO  2000 

C  YES.  SKIP  THE  GEOMETRY  READS,  BUT  RECO  THE  REST  FCR  THE 

C  ACM  BOK  PATTERN 

810  =  31 
XCNTRO  =  XCENTR 
GO  TO  272 
C 

C  READ  CARDS  F  A  AC  G 

15  CONTINUE 
WAX  z  0. 

WA2  z  0. 

PSIW  z  0. 

TUX  z  0. 

TLAZ  »  0. 

PSIT  *  0. 

READ  (NT5.CARCF) 

VRITE  (MIS, 6010)  WAX, WA2, PSIW 


RANXY 

00002 

PUNXY 

00003 

punxy 

00004 

GEOCX 

00036 

CHECK  PR  00002 

CHECK  PR 

00003 

ceocx 

00039 

GEOCX 

00040 

geocx 

00042 

ceocx 

00051 

CEOCX 

00052 

ceocx 

00053 

GEOCX 

00054 

ceocx 

00055 

GECMBX 

00056 

GEOCX 

00057 

FTNX1 

00008 

FTNX1 

00009 

GEOCX 

00058 

GEOCX 

00059 

ftnxi 

00010 

FTNX1 

00011 

FTNXI 

00012 

FTNXI 

00013 

ftnxi 

00014 

ftnxi 

00015 

ftnxi 

00016 

ftnxi 

00017 

ftnxi 

00018 

FTNXI 

00019 

GEOCX 

00060 

GEOCX 

00061 

GEOCX 

00062 

GEOCX 

00063 

GEOCX 

00064 

GEOCX 

00065 

GEOCX 

00066 

GEOCX 

00067 

GEOCX 

00068 

GEOCX 

00069 

GEOCX 

00070 

GEOCX 

(DO  71 

GEOCX 

00072 

GEOCX 

00073 

GEOCX 

00074 

GEOCX 

00075 

GEOCX 

00076 

GEOCX 

00077 

GEOCX 

00078 

GEOCX 

00079 

GEOCX 

00080 

GEOCX 

00G81 

GECMBX 

00082 

GEOCX 

00083 

GEOCX 

00084 

GEOCX 

00085 

GEOCX 

00086 

B25 


IF  (NS  GRP  .EQ.  2)  W?ITE  <NT6, 6012)  TLA X.TLAZ, PSIT 
DECREE  =  .01 745329251943 

CONVERT  DECREES  TO  RADIANS 
IVAL  =  4HR5IW 

IP  (P5IW  .GT.  45.  .<R.  PSIW  ,LT.  -45.)  CO  TO  8030 
PSIW  3  PSIW  *  DECREE 
IF  (NSLRF  .EQ.  1)  CO  TO  30 
IVAL  3  4HP5IT 

SPECIAL  CHECK  FCR  VERTICAL  TAIL 
IF  (PSIT  .EQ.  90.  .AND.  SYM  .LE.  0)  CO  TO  25 
IF  (PSIT  .CT.  45.  .CR.  PSIT  .LT.  -45.)  CO  TO  8030 

SYHT  =  SYH4ETRY  IfCICATCR  FCR  THE  TAIL,  IDENTICAL  TO 
THE  WING  EXCEPT  FCR  A  VERTICAL  TAIL 

STMT  =  SYM 
CO  TO  28 
25  CONTINUE 
SYHT  =  0. 

28  CONTINUE 

PSIT  =  PSIT  *  DECREE 

30  CONTINUE 

NCHRDS  =  I  NIT 
XCENTR  =  XINIT 
«DCE  =  XINIT 
DO  50  1=1,10 
lOKRC(I)  =  I  NIT 
IBOKFd)  r  I  NIT 
IBCn.(I>  =  I  NIT 
30  ZLOCCI)  =  XINIT 
READ  (NTS .CAR DC) 

CHECK  AFC  PRINT  PARAMETERS  READ 
W?ITE  (MT6.601 5)  NCHRDS.XCENTR,  XEDCE 

IVAL  =  WFOCCS 

IF  (NCHRDS  .EQ.  I  NIT)  CO  TO  8010 

IF  (FOCCS  .LE.  0  .CR.  NCHRDS  .C€.  LSCHDS/NSICDV)  CO  TO  8015 

MTBW  =  NORCS 
IVAL  =  «H  XCENTR 

IF  (XCENTR  .EQ.  XINIT)  CO  TO  120 

USE  XCENTR  DIRECTLY,  ICNCRE  XEDCE 
IF  (XEDCE  .HE.  XINIT)  VRITE  (NT6.9010) 

CO  TO  125 

CCT  XCENTR  FRO  XEDCE 
120  CONTINUE 

IF  {XEDCE  .EB.  XiNIT)  CO  TO  8020 
125  CONTINUE 

IF  (ISMPLW  .EQ.  0)  CO  TO  200 
IF  (NSURF  .EQ.  2)  CO  TO  170 
DO  150  I  =  1,  ISMPLW 

IF  (ICHCRD(I)  .CT.  HYBW  .CR.  ICHCRD(I)  .LE.  0)  CO  TO  130 
IF  (ISOKFd)  .EQ.  I  NIT  .CR.  IBOXUI)  .EQ.  INIT)  CO  TO  140 
IF  (IBOKF(I)  ,LT.  1  .CT,  IBOXUI)  .CT.  l.BXCCWNSLSDV)  CO  TO  130 
IF  (IBOKF (I )  .LE.  IBOXL(l)  )  CO  TO  140 
130  W!ITE  (NT6.9020)  I 
ISMPLW  =1-1 
CO  TO  160 
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CEOCX  00122 
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CEOCX  00124 
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CEOCX  00133 
CEOCX  00134 
CEOCX  00135 
CEOCX  00136 
CEOCX  00137 
CEOCX  00138 
CEOCX  00139 
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CEOCX  00141 
CEOCX  00142 
CEOCX  00143 
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140  CONTINUE 

IF  (ZLQC(I)  .EQ.  XINIT)  ZLOCd)  =  0. 

150  CONTINUE 
160  CONTINUE 

WdTE  (NT6.6017)  ISNPLW,  (ICHCRD (I >  ,  IBOXFII)  ,IBOW.(I>  ,  ZLOCd), 
1  I  =  1,ISM*.W  ) 

CO  TO  200 

c  sampling  cf  sownuashes  illegal  if  tail  defined 

170  CONTINUE 

VRITE  (NT6,9030)  ISNfVW 
ISNPLW  =  0 
200  CONTINUE 
C 

C  OBTAIN  THE  LEADING  AND  TRAILING  EDGE  VALUES 

C  CARD  INRJT  CF  FLAKFCRMS  IS  REQUIRED 

READ  (NTS, 5001)  NmLE, NWTE, NTLE, NTTE 
210  VRITE(NT6,e021)  H4.E.NWTE 
GOTO  (214,212)  ,NSURF 
212  VRITE(NT6,6022)  NTLE, NTTE 
214  IVAL  =  4HH4.E 

IF  (M4.E  .LT.  2  .CR.  MA.E  .GT.  10)  GO  TO  8030 
IVAL  =  4HNNTE 

IF  (tWTE  .LT.  2  .CR.  NWTE  .GT.  10)  GO  TO  8030 
IF  (NSLRF  .EQ.  1)  GO  TO  220 
IVAL  =  4HNILE 

IF  (NTLE  .LT.  2  .CR.  NTLE  .GT.  10)  GO  TO  8030 
IVAL  =  4HNTTE 

IF  (NTTE  .LT.  2  .CR.  NTTE  .GT.  10)  GO  TO  8030 
220  CONTINUE 
C 

C  CARDS  I  AH)  4  -  WING  DEFINITION  POINTS 

VRITE  (NT6.6029) 

IVAL  =  9HWING  L.E. 

READ  (NT 5 ,5002)  (XW.E(I )  ,YVCE(i )  ,  1=1  ,HEE) 

VRITE  (NTS, 6030)  IVAL,  (XVLE(I)  ,YW_E(I ) ,  I=J  ,MA_E) 

CALL  EDGCHK(XWLE,YH.E,H4.E,1,IRR) 

IF  (IRR  .NE.  0)  GO  TO  8050 
IVAL  =  9HWING  T.E. 

READ  (NT 5, 5002)  (XWTE(I)  ,YWTE(I)  ,1=1  ,NWTE) 

VRITE  (NTS, 6030)  I VAL,  (XWTE(I)  ,YWTE(I  > ,  1=1  ,NWTE) 

CALL  EDGCHK  (XWTE, YWTE,  NWTE,2,  IRR) 

IF  (IRR  .HE.  0)  CO  TO  8050 
IF  (NSLRF  .EQ.  1)  GO  TO  270 
C 

C  CARDS  K  AND  L  -  TAIL  DEFINITION  POINTS 

IVAL  *  9HTAIL  L.E. 

READ  (NT 5, 5002)  (XTLE(I)  ,VTLE(I) ,  1=1 , NTLE) 

VRITE  (NTS, 6030)  I  VALi  (XTLEd )  ,YTLE(!  > ,  1=1  ,NTLE> 

CALL  EDGCHK  (XTLE.YTLC,  NTLE,  1,  IRR) 

IF  (IRR  .)€.  0)  GO  TO  8050 
IVAL  «  9HTAIL  T.E. 

READ  (NTS, $002)  (XTTEd)  ,YTTE(l>  ,1*1 , NTTE) 

VRITE  (NTS, 6030)  IVAL,  (XTTEd)  .YTTEd)  ,1*1 , NTTE) 

CALL  EDCCHK(XTTE,YTTE,NTTE,2,IRR) 

IF  (IRR  .NE.  0)  CO  TO  8050 
CO  TO  270 
C 
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c  definitioc  to  be  read  frcn  tape 

230  CONTI  MX 
C 

*70  CONTINUE 

•I BETA  a  YM.E(M4_E)/MYBW 
2T2  CONTINUE 

•1  *  BIBETA  *  SORT  (XKACH*XHACH-1  .0) 

B1BTA2  a  BIBETA*  0.5 

B12  s  Bl  *  0.5 

IF  (NSU6DV  .Ml.  1)  CO  TO  275 

US  a  Bl 

UBTAS  a  BIBETA 

CO  TO  280 

275  BIS  a  B1/XSU6CV 

UBTAS  a  B1BETA/XSUBDV 
280  CONTINUE 

VUITE  (NT6.6040)  B1.B1BETA 
C 

C  SET  THE  >*VAL  ARRAT  IF  WS  VMS  INPUT 

C 

IFO*S(1>.EB.-1.0)  CO  TO  295 
DO  290  1=1  ,mvALS 

)*VAL<I>  =  WS (I)  *  <B1/YV4_E<N*.E)> 

290  CONTINUE 
295  CONTINUE 
C 

C  DETER  MI  »C  THE  CLCBAL  COCRCINATE  LOCATION  CF  THE  FIRST  UN- 

C  SUBDIVIDED  PLAPfCRM  BON  CENTER,  XCENTR 

IVAL  =  6HXCENTR 

IF  (XCENIR  .EB.  XINIT)  XCENIR  =  XEDGE  ♦  B12 

mrCEV  a  XM-E(l)  ♦  O04.E(2)-*M«E(l) )  *  B1BTA2  /  YV4.E(2> 

IF  (WVCECM)  XECCEM  =  BIO*  XVA.EU)  -  BIO  ♦  XCNTRO  ♦ 

1  BlO*05M_E(2I  -  XM-E(l))  *  .5  /WCE<2>  -  .5) 

IF  (XCENIR- XEDCOfl  310,330,320 
310  DO  315  I  a  1,51 

XCENTR  =  XCENIR  ♦  Bl 
IF  (XCENIR  .CE.  «DCEVn  CO  TO  330 
315  CONTINUE 
CO  TO  SOW 
320  DO  325  I  a  1,51 

IF  (XCENIR-B1  .LT.  XEDCEW)  CO  TO  330 
XCENIR  a  XCENIR  -  Bl 
3eS  CONTINUE 
CO  TO  80B0 
330  CONTINUE 

C  IS  PREVIOUS  CE0*CTRY  BECIN  USED  - 

IF  (.NOT.  IRVCCOO  CO  TO  355 
C 

C  YES.  CONVERT  X-e  OCR  Dl  NATE  VALUES  TO  NEW  BOX  LENGTH 

PSIDIF  a  PSIT  -  PSIW 
SLIDE  *  -S10  ♦  XCNTRO  -  XCENTR 
DO  335  I  a  1.M4.E 

335  XMLCd)  <  <B10**ULE(I>  ♦  SLIDE)/B1  *  1.0 

DO  340  I  a  l.NWTE 

340  XWTE(I)  a  (B10*XWIE(I)  *  SUDE)/B1  *  1.0 
IF  (USURP  .tfi.  1)  CO  TO  390 
DO  345  I  =  l.NTLE 
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345  XTLE(I)  =  <B10*XTLE(I>  ♦  SLICE)/B1  ♦  t.O  CEOCX 

00  350  I  =  l.NTTE  CEOCX 

350  XTTt(I)  =  <BlO*XTTE(I)  ♦  SLICE) /B1  ♦  1.0  CEOCX 

CO  TO  390  CEOCX 

C  CEOCX 

C  CONVERT  GEOMETRIC  I^CRKATICN  TO  THE  NCN-DIMENSIONAL  CEOCX 

C  NC,  MC,  LC  COCRCimTE  SYSTEM  CEOCX 

345  CONTINUE  CEOCX 

DO  360  I  =  1.NM.E  CEOCX 

»*.£«>  =  (XV4.E(I)-XCENTR)/Bi  «•  1.0  CEOCX 

360  YVLE(t)  =  Y«.E<I) /BIBETA  ♦  0.5  CEOCX 

DO  365  I  =  l.MVTE  CEOCX 

NNTE(l)  =  (XWTE(I)-XCENTR)/B1  4  1.0  CEOCX 

365  VWTE(t)  =  YWTEtD/BIBETA  ♦  0.5  CEOCX 

CO  TO  (370,375)  ,N6URF  CEOCX 

370  CAPL  s  0.  CEOCX 

F5IT  a  0.  CEOCX 

FBI  DIF  =  -Psiw  CEOCX 

MTBT  =  0  CEOCX 

MY  BBT  =  0  CEOCX 

MYBST  =  0  CEOCX 

MY  BBS  T  =  0  CEOCX 

IF  (ISMFLW  .EB.  0)  CO  TO  390  CEOCX 

TRANSFORM  2L0C  FO  THE  5AMFEE  WISH  OKSDS  TO  A  NOt-ClHEKSIQNAL  CEOCX 
(•ROTATED  LC  COCRDINATE  HAVING  ITS  ZERO  ON  THE  WING  CENTER  CEOCX 
LUC  CEOCX 

DO  372  I  =  1,  ISMFLW  CEOCX 

ZLOC(I)  =  (ZLOC(I)  -  VLA2)  /El BETA  CEOCX 

372  CONTINUE  CEOCX 

CO  TO  390  CEOCX 

375  XDIFF  =  VCAX  ♦  XCENTR  -  TLAX  CEOCX 

DO  380  I  =  l.NTLE  CEOCX 

XILE(I)  =  (XTLE(l)-XDIFF)/81  ♦  1.0  CEOCX 

360  VTLE(I)  =  YTLECD/BIBETA  ♦  0.5  CEOCX 

DO  365  I  =  l.NTTE  CEOCX 

XTTE(I)  =  <XTTE(I>-XDIFF)/BI  ♦  1 .0  CEOCX 

365  VTTE(I)  =  YTTE(I)/B1BETA  ♦  0.5  CEOCX 

CAM.  s  (TUAZ-VEAZ)/B1BETA  CEOCX 

FBIDIF  s  MBIT  -  PSIW  CEOCX 

CEOCX 

CHECK  FOR  TAIL  CROSSING  WING  CEOCX 

IF  (FSIDIF)  366,369,367  CEOCX 

366  ir  (CAM.  .LE.  0)  CO  TO  369  CEOCX 

CO  TO  366  CEOCX 

367  IF  (CAM.  .CE.  0)  GO  TO  369  CEOCX 

366  Y CROSS  =  CAFL/  (SIN(FSIW)  -SIN(FSIT) )  ♦  .5  CEOCX 

IF  (TM.C(M4.£)*CQ6(PS!W)  .LT.  Y CROSS)  CO  TO  390  CEOCX 

IF  <VTLE(NTLE)«CQS(FSIT)  .CE.  Y CROSS)  CO  TO  6060  CEOCX 

CO  TO  390  CEOCX 

369  VCR  OSS  «  .5  CEOCX 

C  CEOCX 

C  ZERO  OUT  THE  B<*  CODE  ARRAYS  CEOCX 

360  CONTINUE  CEOCX 

DO  430  J  *  1  iLIOMC  CEOCX 

DO  423  I  «  1.L3XCDW  CEOCX 

420  IDOKWU.J)  s  0  CEOCX 

DO  430  I  *  I  ,LB*CCT  CEOCX 
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4X  tlQKTU.J)  =  o  ceoex 

ceoex 

err  me  (subdivided)  iox  ccoe  array  fcr  me  oh-planfcrm  wing  ceoex 

iocs  ceoex 

new  =  o  ceoex 

ner  *  o  ceoex 

nesr  s  o  ceoex 

mt  s  o  ceoex 

c  ceoex 

cau.  ixcopft  M4.e,YH.e,M4.e,xwTt,Ywre,Nwre,  lbxccw.iboxw)  ceoex 

C  RETURNS-  IBOKW  ,  OC5  FCR  CN  PLANFCRM  BOXES  CEOCX 

C  new  =  LOCATION  OF  FIRST  UNSUBDIVIDED  BOX  CENTER  CEOCX 

C  HXSSW  s  tOCER  CF  SUBDIVIDES  ROWS  ON  THE  WINC  CEOCX 

C  WTBSW  a  RACER  OF  SUBDIVIDED  CHORDS  ON  THE  WINC  CEOCX 

C  MX8W  s  RACER  OF  UNSUBDIVIDED  ROWS  CEOCX 

C  WTBW  a  RACER  CF  IACUBDI  VISED  CHORDS  CEOCX 

C  FEW.OC  a  ARRAY  CF  LEADING  EDGE  LOCATIONS  CEOCX 

C  TEXLOC  a  ARRAY  OF  TRAILING  EDGE  LOCATION  CEOCX 

c  ceoex 

MTBBSW  a  MYBSW  Ceoex 

MX8BW  =  MXBW  ceoex 

MX8BSW  =  MWSW  CEOCX 

IF  {.NCR.  CntCMR)  CO  TO  440  CEOCX 

CALL  TRNTBCtlBOXW.LBXCDW,  1,  HXBSW,  WTBSW,  .T.  )  CEOCX 

WIITC  (NTS, 7040)  (  FE*.0C(I),  1  a  1, WTBSW}  CEOCX 

WIITC  (NT6.7045)  <TEX.0C(I),  I  a  1, WTBSW}  CEOCX 


440  CONTINUE  CEOCX 


C  CEOCX 

C  SEARCH  THE  WINC  FCR  THE  FORWARD  MOST  DIAGONAL  INTERSECTING  CEOCX 

C  AN  CR-HARXRM  BOX.  THIS  CEFUCS  THE  LIMIT  FOR  ANT  TIP  CEOCX 

C  DIAPHRAGM.  CEOCX 

C  JDIAC  a  mE  J -LOCATION  (SUBDIVIDED)  OF  THE  DIAGONAL  AT  CEOCX 

C  THE  FIRST  ROW  OF  mE  PATTERN.  CEOCX 

JDIAC  a  1  CEOCX 

•REV  a  0.  CEOCX 

DO  590  J  a  2, WTBSW  CEOCX 

IREV  a  fV.EV  ♦  1 .0  CEOCX 

IF  (FELLQC(J)  .CT.  (REV)  CO  TO  530  CEOCX 

•REV  a  FLQAT<IFIX<FE*.OC<J)>>  CEOCX 

JDIAC  -  J  -  fREV  CEOCX 

590  CONTINUE  CEOCX 

C  CEOCX 

C  INITIALIZE  THE  I  WAKE  ARRAY  CEOCX 

DO  540  J  a  t, WTBSW  GEO'X 

IWAKE(J)  a  TEXl.CC (J)  CEOCX 

540  CONTINUE  CEOCX 

IF  (WTBSW  ,EW.  LSCHDS)  CO  TO  548  CEOCX 

MTBSW1  a  WTBSW  ♦  1  CEOCX 

DO  544  J  a  WTB3W1 ,  LSCHDS  CEOCX 

544  IWAKC(J)  a  0  CEOCX 

541  CONTINUE  CEOMBX 

IF  (NSURF  .HE.  2)  GO  TO  70S  CEOCX 

C  THERE  ARE  2  SURFACES.  DETERMDC  THE  FIRST  TIAAFCRM  BOX  OF  THE  CEOCX 

C  SECOC  SURFACE  CEOCX 

TWIN  a  .$*(1.0  *  1.0/XSUBDV)  CEOCX 

Dae  s  (XTLC(2)-XTLE<1))  /’  <YTLE<2)-YTLe<I>)  CEOCX 

miNS  r  XTLt(t)A  (YMlN-rTLE(l))  *  CEtE  CEOCX 


00315 

0031 6 

0031 7 

00318 

00319 

00320 

00321 

00322 

00323 

00324 

00325 

00326 

00327 

00328 

00329 

00330 

00331 

00332 

00333 

00334 

00335 

00336 

00337 

00338 

00339 

00340 

00341 

00342 

00343 

00344 

003*5 

00346 

00347 

00348 

00349 

00350 

00351 

00352 

00353 

00354 

00355 

00356 

00357 

00358 

00359 

00360 

00361 

00362 

00363 

00364 

00365 

00366 

00367 

00368 

00369 

00370 

003?! 


B30 


u  u  u 


IXBST  =  X$U8DV*(XM1NS-1.0>  ♦  I XBW  ♦  1  CCOCX 

IF  (AINT (XMIHS)  .Efl.  XMIN5)  1 XBS7  =  JXBST  -  1  CEOCX 

WIN  =  XTLEd  )♦  (1.0  '  YTLEO))  *  DELS  CCOCX 

IXBT  :  XM1N  CCOCX 

IF  (FLGATUXBT)  .EO.  XNIN)  IXBT  =  IXBT  -  1  CCOCX 

IXBT  =  NSUBC«  *  IXBT  ♦  IXBW  CCOCX 

C  IWST  =  LOCATION  OF  FIRST  SUBDIVIDED  TAIL  BOX  CCOCX 

C  IXBT  =  LOCATION  OF  FIRST  UNSUBDIVIDED  TAIL  BOX  CENTER  CCCMBX 

ISUBT  =  2  -  IXBST  CCOCX 

C  ISICT  =  THE  SUBSCRIPT  FCR  ARRAY  IBOXT  WHICH  WILL  KEEP  TAIL  CCOCX 

C  ROWS  WITHIN  THE  BCJUNDSOF  IBOXT  CCOCX 

IF  (CAR.  .*E.  0)  GO  TO  510  CCOCX 

IF  (PSIDIF  .Ea.  0)  GO  TO  700  CCOCX 

C  CCOCX 

C  THE  TWO  SURFACES  ARE  NOT  COFLANAR  CCOCX 

510  CONTINUE  CCOCX 

CC*LAN  =  .F.  CCOCX 

C  CCTERMIFC  THE  BOX  CODES  FOR  THE  SECOE  FLA  Nf CRM  CCOCX 

CALL  BXCCPF<XTLE,YTLE,NTLE.  XTTE.YTTE.NTTE,  LBXCDT,IB0XT(ISUBT,1)>  CCOCX 
C  RETURNS  -  IBOCT,  ONES  FCR  CN-FLAWCRM  BOXES  CCOCX 

C  HX8ST  =  NUFCER  OF  SUBDIVIDED  ROWS  TO  END  OF  TAIL  CCOCX 

C  MYBST  =  NLM3ER  CF  SUBDIVIDED  OKRDS  ON  TAIL  CEOCX 

C  HXBT  =  NLACER  OF  UNSUB  DIVIDED  ROC,  BOTH  PLAYFCKMS  CCOCX 

MYBT  =  NUKSER  OF  UNSUBDIVIDED  CHORDS  ON  TAIL  CCOCX 

FEXLOC  =  LEADING  EDGE  LOCATIONS,  BOTH  FLA  KF  CRMS  CCOCX 

TEXLOC  =  TRAILING  EDGE  LOCATIONS  CCOCX 

C  CCOCX 

C  GET  DIAftftACM  VALUES  FCR  THE  TAIL  CCOCX 

MYBBST  =  MYBST  CCOCX 

IF  {.NOT.  CHECK FR)  CO  TO  515  CCOCX 

CALL  FRNTBC(IBOCT(I$UBT,l), LBXCDT, IXBST,  MXBST, MYBST,  ,T. )  CCOCX 

II  =  MYBSW  ♦  1  CCOCX 

III  =  MYBSW  ♦  MYBST  CCOCX 

WtITE  (NT6.7D40)  (FEXLOC (I)  ,  I  =  II, III)  CCOCX 

W5ITC  (NT6.7D45)  (TEXLOC(I),  I  =  It, III)  CCOCX 

515  CONTINUE  CCCMBX 

IW(  =  0  CCOCX 

CALL  BXCDI  <  IW(,  LBXCDT.LSCHDS,  IBOXT  (ISUBT, 1)  )  CCOCX 

C  RETURNS  -  IBOXT,  CODES  2  AND  3  ADDED  FCR  DIAFHRAGM  AM)  WAKE  CEOCX 

C  MYBBST  =  NUMBER  OF  SUBDIVIDED  OKRDS,  INCLUDING  CEOCX 

C  DIAFHRAM,  FCR  TAIL  CCOCX 

C  MY  BBT  =  NLACER  OF  UNSUBDIVIDCD  CHCXDS  CCOCX 

C  CCOCX 

IF  (.NOT.  (FRB0X  ,CR.  CHECK  PR)  )  CO  TO  520  CCOCX 

CALL  PRNTBC( IBOXT (ISUBT.l ) , LBXCDT ,  IXBST,  MXBST, MYBBST,  ,T.)  CCOCX 

IF  (NSUBDV  ,E8.  1)  CO  TO  520  CCOCX 

IFR  =  (IXBT  -  I  XBW) /NSUBDV  ♦  I  CCOCX 

CALL  FRNTBC (IBOXT (ISUBT, I), LBXCDT,  IFR,  MXBT,  MYBBT ,  .F.  )  CCOCX 

520  CONTINUE  CEOCX 


C  CCOCX 
C  THE  FOLLOWING  LOOP  DCTOIMINES  THE  LOCUS  OF  MAXIMUM  AFTWURD  CCOCX 
C  PROJECTIONS  OF  THE  INTERSECTIONS  OF  THE  TAIL  MACH  CONES  CCOCX 
C  WITH  THE  WING  PUNE  (EXTENDED).  MACH  CONES  FCR  UNSUBOi VIDEO  CEOCX 
C  TAIL  CHC?0S  ARE  USED,  BUT  ALL  ARITHMETIC  IS  IN  THE  SUBDIVIDED  CEOCX 
C  COORDINATE  SYSTEM.  CCCMDX 
C  GECMDX 
C  LOOP  ON  TAIL  CHORDS  CECMDX 


00372 

00373 

00374 

00373 

00376 

00377 

0037$ 

00379 

00380 

00381 

00382 

00383 

00384 

00385 

0C386 

00387 

00388 

00389 

00390 

00391 

00392 

00393 

00394 

00395 

00396 

00397 

□0398 

00399 

00400 

00401 

00402 

00403 

00404 

00405 

00406 

00407 

00408 

00409 

00410 

00411 

00412 

00413 

00414 

00415 

00416 

00417 

00418 

00419 

00420 

00421 

00422 

00423 

00424 

00425 

00426 

00427 

00420 
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CAPLL  *  CA(L 

GEoex 

00429 

c 

(do  «ao  jt  =  NsuecN.wBBST.wuecv  j 

FTNX1 

00020 

JT  r  NHJBCH 

FTNX1 

00021 

525  CONTINUE 

FTNX1 

00022 

YCT  =  JT  -  .5 

GEOCX 

00431 

C 

Y-CFFSET  OF  RECEIVING  CHORD  FROM  CENTER-LINE,  TAIL  PUNE 

GEoex 

00432 

c 

GET  ICT,  THE  I-LOCATION  OF  AFTMC6T  RECEIVING  BOX  ON  TAIL  CHRD 

geocx 

00433 

c 

1$  THE  TAIL  CHORD  CN-PU^CRH  CR  DIAFHRACM  - 

GEOCX 

00434 

IF  (JT  .CT.  MTBST)  CO  TO  550 

GEOCX 

00435 

JJ  s  JT  ♦  MTBSW 

GEOCX 

00436 

ICT  =  T£*.OC(JJ>  ♦  EPS  -  AMCC(  TEXL0C(JJ)-IX8W,  XSUBDV) 

GEOCX 

00437 

CO  TO  555 

GEOCX 

00436 

590  CONTINUE 

GEOCX 

00439 

ICT  =  IXBT  -  NSUBDV 

GEOCX 

00440 

555  CONTINUE 

CECMBX 

00441 

ICT  PI  =  ICT  ♦  NSUBDV 

GEOCX 

00442 

IF  (ICTP1  .CT.  MXBST)  CO  TO  57Q 

GEOCX 

00443 

c 

CHEEK  FCR  WAKE  DIAWRAGM  AFT  CF  TAIL  CHORD 

CECMBX 

00444 

CALL  DCCDER (  IBOKTUSUBT.l)  .LBXCDT,  1CTP1.JT,  MXBST,  JT, 

GEOCX 

00445 

1  .T.,  I CODE) 

GEOCX 

00446 

II  =  1 

GEOCX 

00447 

DO  580  I  =  laPl, MXBST, NSUBDV 

GEOCX 

00448 

IF  (ICCCE(II)  .03.  0)  GO  TO  570 

GEOCX 

00449 

ICT  =  I 

GEOCX 

00450 

II  s  II  ♦  I 

GEOCX 

00451 

5(0  CONTINUE 

GEOCX 

00452 

570  CONTINUE 

GEOCX 

00453 

c 

ICT  =  X-LOCATICN  CF  AFT-MOST  TAIL  BOK  ON  THE  CHORD 

GEOCX 

00454 

CL  =  CC8(PSIW)«CAH-*XSUBDV  ♦  SIN(PSIDIF)*YCT 

GEOCX 

0045S 

c 

EL  s  PERPEM5ICUUR  DISTANCE  FROM  RECEIVING  CHORD  TO  RIGHT 

GECMBX 

00456 

c 

WING  PUNE,  POSITIVE  DOWNWARD. 

GEOCX 

0045’ 

c 

GEOCX 

00458 

c 

ENTRY  INTO  THE  LOOP  FCR  WASH  SAMPLING  CHORDS,  FROM  705* 

GEOCX 

00459 

910  CONTINUE 

GEOCX 

00460 

c 

START  OF  LOOP  ON  WING  CHORDS,  ENDING  AT  650 

GEOCX 

00461 

JW  =  NSUBCN 

GEOCX 

00462 

(DO  CONTINUE 

GEOCX 

00463 

VJW  =  JW  -  .5 

GEOCX 

0G464 

c 

YJW  =  Y-OFTSET  OF  SE7CING  CHORD  FROM  CENTER  LI  PC, 

GEOCX 

00465 

c 

WING  PUNE 

GEOCX 

00466 

YMUBAR  =  -YJW  ♦  C06(PSIDIF)*YCT  ♦  SIN(PSIW)*CAPLL*XSUBDV 

GECMBX 

00467 

c 

YMjBAR  =  Y-OISTANCE  BETVCEN  CHORD  CENTERS,  SENDING  (WING) 

GEOCX 

00460 

c 

PUNE 

GEOCX 

00469 

IF  (ABS (YMUBAR)  .LE.  HALFBX)  GO  TO  630 

GECMBX 

00470 

IF  (YMUBAR  .LT.  -HALFBX)  YMUBAR  =  YMUBAR  ♦  HALFBX 

GEOCX 

004 7 J 

IF  (YMUBAR  .CT.  HALFBX)  YMUBAR  =  YMUBAR  -  HALFBX 

GEOCX 

00472 

c 

YMUBAR  s  V-BISTANCE  TO  NEAREST  BOK  EDGE,  WING  FUPC 

GEOCX 

0047J 

WIUBAR  =  SORT  (YMUBAR  **2  *  (EL*XSUBDV)**2  ) 

GEOCX 

00474 

c 

XNU8AR  =  DISTANCE  FORWARD  FRCM  RECEIVING  CENTER  TO  NEAR¬ 

GEOCX 

00475 

c 

EST  PORTION  OF  SENDING  CHORD 

GEOCX 

00476 

GO  TO  635 

GEOCX 

00477 

690  CONTINUE 

GEOCX 

00478 

WUBAft  S  AB$(EL)«XSUBDV 

GEOCX 

00479 

695  CONTINUE 

GEOCX 

00480 

MUBAA  *  XNUBAR  *  HALFBX 

GEOCX 

00481 

INTRST  s  ICT  -  IFIX(XNUBARpEPS  -  AMODOCNUOAR,  XSIBDV)  > 

GEOCX 

00402 

IF  (JW  .GT.  MYBBSW)  GO  TO  640 

GEOCX 

C04«3 

u  u  u  u  wwu 


IWAKE(jW)  =  MAX) (IWIKE(JW) ,  INTRST)  CECMBX 

co  to  690  ceoex 

640  CONTINUE  ceoex 

IF  (INTRST  .LE.  JW-JDIAC)  CO  TO  660  CECHBX 

mtbbsw  =  jw  ceoex 

IWlKEtJW)  i  INTRST  CECMBX 

650  CONTINUE  ceoex 

IF  (NSUBC2  .E0.  0)  CO  TO  657  ceoex 

BO  655  I  =  1.NSUBD2  ceoex 

iwkKEow-n  =  ivakeuw)  -  i  ceoex 

iwake(jwm)  =  ivakeijvo  -  i  ceoex 

655  CONTINUE  ceoex 

657  CONTINUE  ceoex 

jw  =  jw  ♦  nsubdv  ceoex 

go  to  600  ceoex 

ETC  OF  LOOP  ON  WING  CHCRDS  ce<  ex 

:<.oex 

eeo  continue  ceoex 

if  (ismplw  0)  co  to  7u6  ceoex 

6B0  CONTINUE  ceoex 

JT  =  JT  ♦  NSUBCV  FTNX1 

IF  (JT  .LE.  MfBBST)  CO  TO  525  FTNX1 

EM5  OF  LOOP  ON  TAIL  CHORDS,  FROM  548*  CEOeX 

ceoex 

BBS  CONTINUE  ceoex 

KXBBSW  =  hxbsw  ceoex 

DO  690  JW  =  NSLBCN.HYBBSW,  NSUBDV  Ceoex 

KXBBSW  -  HAND  (MXBBSW,  I  WAKE(  JW) )  ceoex 

6BO  CONTINUE  CECHBX 

KXBBW  =  MXBBSW  CEOeX 

IF  (NSUBCV  .CT.  1)  MXBBW  =  (MXBBW-I XBW) /NSUBCV  ♦  1  CEOeX 

IF  (CHECKER)  WUTE(NT6, 7010)  (IWAKE(I ) ,  1=1 , MYBBSW)  Ceoex 

co  to  720  ceoex 

ceoex 

THE  TWO  SURFACES  ARE  CCPLANAR.  ENTER  THE  SECOC  HANFCRM  ceoex 

INTO  THE  SAKE  BOX  ARRAY  CEOCX 

too  continue  ceoex 

COHAN  =  .T.  CECHBX 

CALL  BXCCPF(XTLE,YTLE,NTLE,  XTTE.YTTE.NTTE,  LBXCCW,  IBOXW)  ceoex 

M9BSW  =  MXBST  ceoex 

if  (.not.  check pr)  co  to  72o  ceoex 

CALL  PRNTBCdBCXW, LBXCCW,  IXBST,  MXBST, MYBST,  .T.)  ceoex 

ii  :  mybsw  ♦  t  ceoex 

III  3  MTBSW  ♦  MYBST  ceoex 

WMTC  (NT6.7040)  (FEXLQC(I),  I  s  II, HI)  CE06X 

WUTt  (NTS, 7045)  (TEXLOC(I),  I  3  II, HI)  CCCMBX 

co  to  720  ceoex 

C  NO  TAIL  IS  DCFltCD.  IS  DCMNWtSH  SAMPLING  DESIRED-  CCCMBX 

7ds  continue  ceoex 

COPLAN  «  .f.  ceoex 

if  (ismplw  .a.  o)  co  to  720  ceoex 

C  BYPASS  THE  TAIL  HAFFCRM  AND  BOX  CODE  SETUP,  AND  LOOP  ON  SAMPL  CECMBX 

C  CHORDS  TO  DEFINE  WINC  W4KC  REGION  CCOCX 

C  <  DO  706  JCHRD  «  1, ISMPLW  )  FTNX1 

JCHRD  x  1  FTNX1 

704  CONTINUE  FTNXt 

JT  c  (ICH0RC(JCHRD)-1)*NIUBDV  ♦  NSUflCN  CEOeX 


00464 

00465 

00486 

00467 

00486 

00469 

00490 

00491 

00492 

00493 

004°4 

00495 

00496 

00497 

00496 

00499 

00500 

00501 

00502 

00503 

00023 

00024 

00S04 

00505 

00S06 

00507 

00508 

00509 

00510 

00511 

00512 

00513 

00514 

00515 

00516 

00517 

00518 

00519 

00520 

00521 

00522 

00523 

00524 

00525 

00526 

00527 

00528 

00529 

00530 

00531 

00532 

00533 

00534 

00025 

00026 

00027 

00536 
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IF  (1B0KF (JCHRD)  .EO.  INIT)  IBOXF  (JCHRD)  a  (TEM.0C(JT)-IX8W)/ 

1  NSUBDV  ♦  t 

IP  (ISOM.  (JOED)  .E8.  I  NIT)  IBOM.  (JCHRD)  a  (TEM.OC  (JT)-IXBW)/ 

1  NSUBDV  ♦  1 

YCT  *  JT  -  .a 

ICT  a  ( I  BOM.  ( JCHRD) -1)  *  NSUBDV  ♦  IXBW 

O.  a  CQB(PSIW)  *  ZLOC(JCHRD)  -  SIN(PSIW)  *  YCT 

CAPLL  =  ZLCC  (JCHRD) 

CO  TO  580 

C  THE  LOGIC  FCR  A  TAIL  CHORD  IS  USED.  AFTER  THE  WIND  WAKE 

C  BCUNCS  ARE  DETERMINED  FCR  THIS  TAIL  CHCRD,  CONTROL  IS  RETURNED 

C  TO  THIS  LOOP 

TOS  CONTINUE 
IDS  CONTINUE 

JOED  =  JCHRD  ♦  1 
IF  (JCHRD  .LE.  ISMfLW)  CO  TO  704 
C  END  OF  LOOP  ON  SAMPLE  CHORDS 

CO  TO  663 
C 

C  CET  DIAPHRAGM  BOXES  CODES  FCR  THE  WING 

720  CONTINUE 

CALL  BXCDI  (IWAKE.LBXCDW.LSCHBS,  IBOXW  ) 

C  RETIRN6  -  IBOXW,  CODES  2  AM)  3  ADDED  FCR  DIAfHrAOt  REGIONS 

C  NNBBSW  =  NUMBER  CF  SUBDIVIDED  CHORDS,  INCLUDING  DIA- 

C  PHRAGm 

C  MTBBW  =  NUK3ER  OF  UNCUB  DIVIDED  CHORDS 

c 

C  PRINT  BOX  CODES 

IF  (.NOT.  (NRBQX  .OR.  CHECK  NR)  )  GO  TO  725 
CALL  PRNfTBC (I BOXW, LB  XCDW,  l,  MXBBSW,  MPBBSW,  .T.) 

IF  (NSUBDV  .NE.  1)  CALL  PRNTBC  (IBOXW,  LB  XCDW, 

1  1.  (MXBBSW- 1 5®WvNSC® CV) /NSUBDV,  NfCBBW,  .F.  ) 

725  CONTINUE 

DETERMINE  THE  PLANAR  AIC  ARRAY  SIZE 
N*LKRN  r.  MAO  (MXB8W,  MXBT- 1 XBT/ NSUBDV  ♦  1) 

IF  (COPLAN)  NfLKRN  =  MXBT 

VIIITE  THE  BOX  CODE  ARRAYS  INTO  THE  GEOMETRY  SCRATCH  FILE 
REWINC  ICEOSC 
CALL  RDINIT 
I  TYPE  =  5HMIXED 
IVAL  =  5HIB0XW 
PARM(l)  =  0. 

BARM  (2)  =  XMACH 

M  a  MXBBSW 

N  a  (MYBBSW-D/NCWJD  *  l 
K  *  LB XCDW 

CALL  W?TEMX(ICC06C,MXWI!T,RANOOU,  NES,  NtCiLS,  N4R  ,LWB,K,  ID, 

I  IBOXW,  I  TYPE,  M,N,  FARM,  IRR  ) 

IF  (IRR  .NE.  0)  CO  TO  8070 
C 

IF  (NSURF  .tt.  1)  CO  TO  730 
IF  (COPUN)  CO  TO  730 
IVAL  »  SHIBOXT 
M  a  MXBST  -  I X8ST  ♦  I 
M  a  (MYBBST  -  n/NCVRD  4  1 


geonex 

00537 

CEONEX 

00536 

GEONEX 

00539 

CEONEX 

00540 

CEONEX 

00541 

CECNEX 

00542 

GEOEX 

00543 

CEONEX 

00544 

CEONEX 

00545 

CEOEX 

00546 

CECNEX 

00547 

CEONEX 

00548 

CEOEX 

00549 

CECtEX 

00550 

FTNX1 

00028 

FTNX1 

00029 

CEOEX 

00551 

CECNEX 

00552 

CEOEX 

00553 

CECNEX 

00554 

CEOEX 

00555 

CEOEX 

00556 

CECNEX 

00557 

GEOEX 

00558 

CEOEX 

00559 

CEOEX 

00560 

GEOEX 

00561 

CEOEX 

00562 

CEOEX 

00563 

GEOEX 

00564 

CECNEX 

00565 

CEOEX 

00566 

CEOEX 

00567 

CEOEX 

00568 

CEOEX 

00569 

CEOEX 

0057D 

GEOEX 

00571 

CECNEX 

00572 

CECMBX 

00573 

GEOEX 

00574 

GEOEX 

00575 

GEOEX 

00576 

CEOEX 

00577 

CEOEX 

00578 

CECMBX 

00579 

CECNEX 

00580 

CECNEX 

00581 

CECNEX 

00582 

CECNEX 

00583 

CEOEX 

00584 

CEOEX 

00585 

CEOEX 

00586 

CECNEX 

00587 

CEOEX 

00588 

CEOEX 

00589 

CEOEX 

00590 

CECMBX 

00591 
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K  =  LBXCDT  ceoex 

CALL  WRTeMXdCEC6C,MXWRlT,RAteau,tRS,tHS,L$,W«,LWe,K,ID,  CEOCX 

t  IBOXT,  ITYPE.  M,N,  PARM,  IRR >  CEOCX 

IF  (IRR  .NE.  0)  CO  TO  8070  CEOCX 

c  ceoex 

C  CHECK  FCR  DIAPHRAGMS  CRC6SING  VERTICALLY  CEOCX 

IF  (Y CROCS  .LE.  .5)  CO  TO  730  CEOCX 

IF  {  FLOAT (HYB8T)  ACCS ( P$I  T)  .LT.  Y CROSS)  CO  TO  730  CEOCX 

IF  (  FLOAT (MYBBW)  K06  (PSI W)  .GE.  Y CROSS)  CO  TO  8080  CEOCX 

c  ceoex 

C  WRITE  THE  LEADING  AND  TRAILING  EDGE  LOCATIONS  ONTO  SCRATCH  CEOCX 

730  CONTINUE  CEOCX 

m  =  i  CEoex 

N  =  MTBSW  +  MYBST  CEOCX 

K  a  1  CEOCX 

IVAL  =  WFEXLOC  CEOCX 

CALL  WRTEHXdGECSC.MXWRIT.RANDOU.tFS.NC.LS.tlR.LWfi,  K,  ID,  CEOCX 

1  FDO.OC,  ITYPE,  M,N,  FARM,  IRR)  CEOCX 

IF  (IRR  .tC.  0)  CO  TO  8070  CEOCX 

IVAL  *  6HTD4.0C  CEOCX 

CALL  VRTEHXdCEC&C.MMRIT.RANDOU.NFS.MC.LS.MR.LVC,  K,  ID,  CEOCX 

1  TEXLCC,  ITYPE,  M,N,  FARM,  IRR)  CEOCX 

IF  (IRR  .»€.  0)  GO  TO  8070  CEOCX 

C  CEOCX 

C  DETERMINE  THE  ON-RJkKFCRM  FRACTIONAL  PART  OF  ALL  UNSUB  DIVIDED  CEOCX 

C  BOXES  CUT  BY  A  PLAtFCRH  EDGE  CEOCX 

CALL  CMAREAdBOXW.LBXCCW,  .T.,  ALPHA,  l  JALPH,  NALWW)  CEOCX 

NU-fH  =  NALWW  CEOCX 

IF  (NSURF  .EB.  1  .CR.  COPLAN)  CO  TO  740  CEOCX 

CALL  CMAREA(IB0XT(ISUBT,1), LBXCDT,  .F.,  ALFHA (NALRfWd ) ,  CEOCX 

1  I JALfH  (NALfH*  1  > ,  NALPHT)  CEOCX 

NALPH  =  NALFH  ♦  NALPHT  CEOCX 

740  CONTINUE  CEOCX 

IF  (CHECK PR)  VRITE(NT6,7030)  (IJALfH'»>*  ALRiA(I)  ,1=1 , NALfH  )  CEOCX 

C  CEOCX 

C  WRITE  THE  AREA  MULTIPLIERS  CEOCX 

Msl  CEOCX 

N  a  NALW  CEOCX 

K  s  1  CEOCX 

I  PAR M  (3)  s  NALfHW  CEOCX 

IVAL  =  SHALfHA  CEOCX 

CALL  VRTEMXdCECSC.MXWRIT.RANDOU.trs.tHS.LS.NR.LWC.  K,  ID,  CEOCX 

t  ALPHA,  ITYPE,  M,N,  FARM,  IRR)  CEOCX 

IF  (IRR  .NE.  0)  CO  TO  8070  CEOCX 

IVAL  s  6HIJALPH  CEOCX 

CALL  WRTE*XdCe«C,MXWRlT,RANDOU,tF’S,t*B,LS,t*R,LW*,  K,  ID,  CEOCX 

1  IJAL PH,  ITYPE,  M,N»  PARH,  IRR)  CEOCX 

IF  (IRR  .PC.  0)  CO  TO  0070  CEOCX 

C  CEOCX 

C  DETER  MI  Lt  THE  SPATIAL  AJC  PARAMETERS  CEOCX 

C  THE  MUAIC  ARRAYS  ARC  WRITTEN  TEMPORARILY  ON  IVPSC  FOR  EDITTINC  CEOCX 

C  CMTO  IWTFSC.  AFTER  THE  KPT—  ARRAYS  ARE  WRITTEN  ON  CECMBX 

C  ICECSC,  ALL  NSPATK  ARRAYS  ARE  TRANSFERRED  TO  ICE08C  CEOCX 

C  I SCR  *  MUtCER  OF  MIMICS  TRANSFERRED  TO  IWRFSC  CEOCX 

C  NSCR  *  TOTAL  NUMBER  OF  MUAICS  PRESENTLY  CN  IVPSC  CEOCX 

C  CEOCX 

I  SCR  s  0  CECMBX 


00592 
00593 
00594 
00595 
00596 
00597 
00598 
00599 
00600 
00601 
00602 
00603 
00604 
00605 
00606 
00607 
00608 
00609 
00610 
00611 
00612 
00613 
00614 
00615 
00616 
00617 
00618 
00619 
00620 
00621 
00622 
00623 
00624 
00625 
00 626 
00627 
00628 
00629 
00630 
00631 
00632 
00633 
00634 
00635 
00636 
00637 
00638 
00639 
00640 
00641 
00642 
00643 
00644 
00645 
00646 
00647 
00648 
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**C*  «  0 

CECAflX 

00849 

WOO*  3  o 

CE0A6X 

00650 

woeii  3  o 

CECACX 

00651 

I  FARM  <3 )  =  0 

ceoa ex 

00652 

IFARM(S)  3  0 

CECACX 

00653 

REWIAC  IWTFSC 

CECACX 

00654 

REWIND  IVPSC 

CECACX 

00655 

N  r  2 

CECACX 

00656 

K  =  2 

CEOCX 

00657 

3  0 

CEOMBX 

00658 

i 

II 

o 

CEOCX 

00659 

IF  <SVM  .£8.  0)  CO  TO  904 

CEOCX 

00660 

IF  (PSIW  .03.  0  .CR.  .NOT.  DIHW)  CO  TO  800 

CEOCX 

00 601 

c 

CEOCX 

00662 

c 

START  OF  COOP  FOR  WING- WING  PARAMETERS  ON  RECEIVING  CHORES, 

CEOCX 

00663 

c 

UN8UBDI VICED  (DET ERMINES  SPATIAL  MUAIC  VALUES) 

CEOCX 

00664 

DO  790  JCOL  =1  ,MfBBW 

CEOCX 

00665 

c 

CEOCX 

00666 

CAUL  PVMIC  <.T. i  IBOKW.LBXCDW,  IVRKE,  JCCL> 

CEOCX 

00667 

c 

COMPUTES  MUAIC  ARRAY  FOR  THE  LEFT  SURFACE  CONTRIBUTION  TO 

CEOCX 

00668 

c 

CHORD  JCOL  OF  THE  RIGHT  SURFACE 

CECACX 

00669 

c 

SURF  =  .T.  INDICATES  SOME  RIGHT  SURFACE  CONTRIBUTION  WAS 

GECACX 

00670 

c 

fcuab 

CEOCX 

00671 

IF  (.NOT.  SURF)  CO  TO  800 

CECACX 

00672 

AM«  s  AW*  *  1 

CEOCX 

00673 

tePATx  =  yu* 

CEOCX 

00674 

KPTVMCNWWO  =  N5RATK 

CECACX 

00675 

IVAL  =  10H  WING-WING 

CEOCX 

00676 

IF  (CHECXPR)  WRITE(NT6,7020)  IVAL,  JCCL.YBAR.a,  NROkfi,  (MUAIC  (1, 

CEOCX 

00677 

1  NRCW6-I*!)  .MUAIC tt, WRCVC-I+1) ,  I=l,NROW5> 

GECACX 

00678 

c 

CEOCX 

00679 

c 

WRITE  MUAIC  ARRAY  ON  THE  SCRATCH  FILE 

CEOCX 

00680 

N  3  AfROUl 

CECACX 

00681 

fWRM<4)  s  YBAR 

CEOCX 

00682 

«RM(5>  s  a 

GECACX 

00683 

CALL  WRTEMXR IVPSC,  MXWRIT.RAACCU.AfS, W6,LS,NMR,LW5,  K,  ID, 

CEOCX 

00684 

1  MUAIC,  I TYPE,  M,N,  FARM,  IRR) 

CEOCX 

00685 

IF  (IRR  .AC.  0)  CO  TO  8073 

CEOCX 

00686 

MCR  s  NSCR  ♦  1 

CEOCX 

00687 

c 

CEOCX 

00688 

790  CONTINUE 

CEOCX 

00689 

c 

END  OF  COOP  ON  RECEIVING  CHORDS  FOR  WINC-WING  PARAMETERS, 

CECACX 

00690 

c 

CEOCX 

00691 

«»  CONTINUE 

ceotx 

00692 

NTTK  s  0 

CECACX 

00693 

IF  (NSURF  .AC.  2)  CO  TO  900 

CEOCX 

00694 

IF  (SYMT  .IS.  0)  CO  TO  900 

CEOCX 

00695 

IF  (PSIT  .ca.  0  .OR.  .NOT.  DIHT)  CO  TO  900 

CECACX 

00696 

IF  (PSIOIF  .69.  0.)  REWIAC  IVPSC 

CEOCX 

00697 

c 

CECACX 

00698 

c 

START  OF  LOOP  FOR  TAIL-TAIL  PARAMETERS  CN  RECEIVING  CHORDS, 

GECACX 

00699 

c 

UNSUBOIVIDES 

CEOCX 

00700 

00  893  JCCL  s  l.MYBBT 

CECACX 

00701 

c 

CEOCX 

00702 

CALL  PWWAIC  C.F. ,  IBOKTUSUBT.l)  .LBXCCT,  I WAKE,  JCQL) 

CECACX 

00703 

c 

COMPUTES  MUAIC  ARRAY  FCR  THE  CONTRIBUTION  OF  THE  LEFT  TAIL  ON 

CECACX 

00704 

c 

CHORD  JCCL  OF  THE  RIGHT  TAIL  SURFACE 

GECACX 

00705 

B36 


ft  r> 


C 

IF  (.NOT.  SURF)  CO  TO  900 
NTTX  =  MTTR  ♦  1 
C 

IVAL  =  10H  TAIL-TAIL 

C  IF  THE  WINC  ANC  TAIL  HAVE  THE  SAME  DIHEDRAL,  MODIFY  THE  WIND 

C  MUAIC  ARRAY  VHERE  NEEDED  BY  THE  TAIL,  A N)  USE  IT 

IF  tPSIDIF  .EQ.  0.)  CO  TO  840 
C  OTHERWISE,  WRITE  THE  MUAICS  FOUND  ONTO  IVPSC 

N5PATX  =  NSPATX  ♦  1 
KFTTTINTOO  =  NSPATX 
IVAL  =  10H  TAIL-TAIL 

IF  (CHECXPR)  VRITE{NT6,7D20)  IVAL,  JCCL.YBAR.EL,  NROHS,  (MUAIC(1 , 

1  (R06-I+1)  ,MUAIC(2>NROH5-l4l) ,  I=l,NcOWB> 

WRITE  MLMIC  ARRAY  ON  SCRATCH  FILE 
N  =  MR  06 
HARM  <4 )  =  YEAR 
HARM  (5)  =  EL 

CALL  WRTEMXdVPSC,  MXWRIT.RANDOU.AfS.NC.LS.NC.LWS,  K,  ID, 

1  MUA1C,  I  TYPE,  M.N,  PARM,  IRfi) 

IF  <IRR  .NE.  0)  CO  TO  8075 
NSOR  =  NSCR  ♦  1 
C 

GO  TO  895 
840  CONTINUE 

IF  (ISCR  .CE.  A6CR)  CO  TO  850 
CALL  RDIWT 

CALL  REACMXdVPSC,  MXWRIT.RAFCCU.Ars.NC.LS.AMR,  X,  NID.ID, 

1  I  TYPE,  LRS,  MUAICL,  M,N,  FARM,  IRR) 

IF  (IRR  .AC.  0)  CO  TO  8090 
ISCR  =  ISCR  ♦  1 

C  MERGE  THE  TWO  MIMIC  ARRAYS 

DO  845  I  =  1,N 
IF  (I  .CT.  NR  OHS)  CO  TO  842 
IF  (MUAICL (1 , 1 )  .EB.  0)  CO  TO  845 
IF  (MIMIC (1 ,1)  .EQ.  0)  CO  TO  842 
MUAICIl ,  I )  =  MIND  (  MU4IC  (1,1), MUAICL  (1,1)  > 

MLM!C(2,I)  =  MAX) (  MIMIC (2, 1 ) , MUAICL (2, 1 )  > 

GO  TO  845 

842  MLMIC <1 1 1 )  *  MUAICL <1, 1) 

MLMICC2, 1 )  =  MUAia(2,I> 

845  CONTINUE 

N)0«  s  MAX) <MRCW$iN) 

XPTTT  (NTTX)  =  ISCR 

IF  (CHECK  MR)  WJITE<NT6,7020)  IVAL, JCCL.YBAR.EL,  NROWB, 

1  (MUAICIl  .WROC-l+l)  ,MUAIC(2,NR0M5-l4l)  •  I  =  l.NROHB) 

GO  TO  855 

C  THERE  WERE  NO  MATRICES  TO  BE  MERCED 

850  NS  PATH  *  NSPATX  4  1 
XPTTT(NTTK)  *  NSPATX 

C  WRITE  MERGED  AICS  ONTO  2A0  SCRATCH  FILE 

$55  CONTINUE 

N  *  NR  CHS 

CALL  VRTCMXUWTFSC,  MXWRIT.ftAtCOU, **,*«, IS, Nft.LWS,  X,  ID, 

1  MUAIC,  I TYPE,  M.N,  PARM,  IRR) 

IF  (IRR  .HE.  0)  GO  TO  SUO 


C€oex 

00706 

CEOCX 

00707 

ccoex 

00708 

CEOCX 

00709 

CEOCX 

00710 

CEOCX 

00711 

CEOCX 

00712 

CEOCX 

00713 

CEOCX 

00714 

CEOCX 

00715 

CEOCX 

00716 

CEOCX 

00717 

CEOCX 

00718 

CEOCX 

00719 

CEOCX 

00720 

CEOCX 

00721 

CEOCX 

00722 

CEOCX 

00723 

CEOCX 

00724 

CEOCX 

00725 

CEOCX 

00726 

CEOCX 

00727 

CEOCX 

00728 

CEOCX 

00729 

CEOCX 

00730 

CEOCX 

00731 

CEOCX 

00732 

CEOCX 

00733 

CEOCX 

00734 

CEOCX 

00735 

CEOCX 

00736 

CEOCX 

00737 

CEOCX 

00738 

CEOCX 

00739 

CEOCX 

00740 

CEOCX 

00741 

CEOCX 

00742 

CEOCX 

00743 

CEOCX 

00744 

CEOCX 

00745 

CEOCX 

00746 

CEOCX 

00747 

CEOCX 

00748 

CEOCX 

00749 

CEOCX 

00750 

CEOCX 

00751 

CEOCX 

00752 

CEOCX 

00753 

CEOCX 

00754 

CEOCX 

00755 

CEOCX 

00756 

CEOCX 

00757 

CEOCX 

00758 

CEOCX 

00759 

CEOCX 

00760 

CEOCX 

00761 

CEOCX 

00762 

B37 


c 


19]  CONTINUE 

C  EM!  CT  LOOP  FCR  TAIL-TAIL  PARAMETERS,  FROM  800* 

C 

800  CONTINUE 

C  CCMFS.ETE  ANT  COPT  FROM  FIRST  TO  SEC0M5  SCRATCH  FILE 

IF  (ISCR  .SB.  0)  REWIM)  IVPSC 
IF  (ISCR  .CE.  NSCRi  CO  TO  904 
II  =  I SCR  ♦  1 
00  902  I  =  II.NSCR 
CALL  ROINIT 

CALL  REACMXIIVPSC,  MXVRIT.RAMJOU.FfS.WC.LS.MC,  K,  NID.IC, 

1  I  TYPE,  LRS,  MUAIC.  M.N,  FARM,  IRR) 

IF  (IRR  .ME.  0)  CO  TO  8090 

CALL  WrrENXHWTFsC,  MXVKIT.RAMXU, FFS, FHS.LS, MR.LWS,  K,  ID, 

1  MUAIC,  I  TYPE,  M.N,  PARM,  IRR] 

IF  (IRR  .TC.  0)  CO  TO  8110 
902  CONTINUE 
904  CONTINUE 

C  COMPUTE  THE  RIOfT  AM]  LEFT  WING  IMLUENCE  PARAMETERS  CN  THE 

C  TAIL  OR  SAMPLE  CHORDS 

M1MIK  =  0 
M.WTK  =  0 
I SCR  =  0 
NSCR2  =  0 
REWIM)  IVPSC 
I  FARM  (6)  =  1 

C  INITIALIZE  THE  MUAIC  ARRAY'S 

DO  908  I  =  1,90 
MUAIC  (1 , 1)  =  1*1 
MUAICC2.I)  =  0 
MUAICL(l.K)  =  I*  I 
MUAICL (2, 1  )=  0 

908  CONTINUE 

IF  (CCfLAN)  CO  TO  1015 

IF  (NBLRF  .t€.  2)  CO  TO  1120 

CAUL  =  CAFL 

YWUVSP  =  CAPLL*SIN(PSIW) 

JTCOL  =  NTBSW  -  NSUBC2 
C 

C  START  OF  LOOP  CN  TAIL  CHORDS,  TO  COMPUTE 

C  WING  -  TAIL  IMLUENCE  PARAMETERS 

C  (  DO  1010  JCCL  =  l.MTBBT  > 

JCCL  =  1 

909  CONTINUE 

IF  (JCCL  .LE.  MTBT)  CO  TO  910 
IRON  =  <IX8T-IX8W)/N5UBDV  ♦  1 
CO  TO  915 
*10  CONTINUE 

JTCOL  s  JTCa  ♦  NSU6DV 

IRCW  s  (TCl«.CC<JTCCL)-IXBW)/NSUeCV  ♦  1 

IF  (IRCW  .CO.  MXBT)  CO  TO  930 


CCOCX  0076s 
CEOCX  00764 
CEOMJX  00765 
CEOCX  00766 
CCOCX  00767 
CCOCX  00768 
CEOCX  00769 
CCOCX  00 770 
CCOCX  00771 
CCOCX  00772 
CCOCX  00773 
CCOCX  00774 
CCOCX  00773 
CCOCX  00776 
CCOCX  00777 
CCOCX  00778 
CCOCX  00779 
CCOCX  00780 
CCOCX  00781 
CCOCX  00782 
CCOCX  00783 
CCOCX  00784 
CCOCX  00785 
CCOCX  00786 
CCOCX  00787 
CCOCX  00788 
CCOCX  00789 
CCOCX  00790 
CCOCX  00791 
CCOCX  00792 
CCOCX  00793 
CCOCX  00794 
GCCMBX  00795 
CCOCX  00796 
G£OCX  00797 
CCOCX  00798 
CCOCX  00799 
CCOCX  00800 
CCOCX  00801 
CCOCX  00802 
CCOCX  0080., 
CCOCX  00804 
FTNX1  00030 
FTNX1  00031 
FTNX1  00032 
CCOCX  00806 
CCOCX  00807 
CCOCX  00808 
CCOCX  00809 
CCOCX  00810 
CCOCX  00811 
CCOCX  00812 


919  CONTIKJC  CCOCX  00813 

CALL  DCCCeR<IBOXT<I3U8T,l>,L8XCDT,  IR0W.JCCL,  MXBT,  JCCL,  .F..IC00E)  CCOCX  00814 

II  =  I  GEOCX  00815 

00  917  I  =  IRCW, MX8T  CECMBX  00816 

IF  (ICCCC(II)  .NE.  0)  CO  TO  918  CECMBX  00817 


n  n 


t!  i  II  ♦  1 
Jl7  CONTINUE 
918  CONTINUE 
HI  =  1 

DO  920  I  =  III.  MX8T 
IF  (ICODF(II)  .ES.  0)  CO  TO  925 
II  =  II  ♦  1 
920  CONTI  MJE 
925  IRON  =  IRON  >11-2 

C  ENTRY  INTO  THE  LOOP  FRCM  SAMPLE  WASH  LOOP,  FRCM  1120* 

930  CCNTIHJE 

CALL  »VTA1C(  IBOXW.LBXCEW,  IRCW.JCa,  CAR-L.  YMUYSP) 

CETS  THE  HUAIC  AND  MUAICL  ARRAYS  FO<  RICHT  AT®  LEFT  CONTRI¬ 
BUTIONS  TO  THE  TAtL 
IF  (SURF)  CO  TO  935 
IF  <  .NOT.  SLRFU  CO  TO  1015 
CO  TO  965 

935  WWTK  =  WWTK  ♦  1 
C  DETERMINE  WHETHER  WING  AND  TAIL  ARE  PARALLEL 

IF  (PSIC1F  .EB.  0  .AM).  NSLRF  .EQ.  2)  CO  TO  940 
ffiFATX  =  WPATX  ♦  1 
KPTRWT  (WWTK)  =  N5PATK 
C  WJITC  NEW  HUAIC  ARRAY  ON  SCRATCH 

IVAL  s  10Ht  WNG-TAIL 
N  =  WCL6 
farm  (4)  =  ybar 
fKRM(S>  =  EL 

CALL  W«TE)«<IVPSC.  MXW?IT,RAM50U,NFS,M«,LS,W«,LV6,  K,  ID, 

1  MUAIC,  I  TYPE,  M.N,  PARM,  IRR) 

IF  (lift  .NE.  0)  CO  TO  6075 
WCR2=  NSCR2  ♦  1 

IF  (OCCKPR)  WHTE(NT6,7020>  IVAL,  JCa, YBAR, a,  WOWS,  (MUAIC (1 , 
1  ,MUAIC12,W0W5-I  +  1)  ,  1=1, TROWS) 

C  REINITIALIZE  THE  RICHT  MUAIC  ARRAY 

DO  937  I  =  i,waws 
MUAICU.l)  =  HI 
MJAICC.I)  =  0 
937  CONTIHJE 

c 

CO  TO  962 

C  OLD  MUAIC  ARRAY  HAS  BEEN  FOUM3  WHICH  HATCHES 

940  CONTINUE 

C  ALL  RICHT  HAW  MUAIC3  ARE  THE  SAME,  PARALLa  SURFACES 

IF  <jca  .CT.  1>  CO  TO  945 
WPATX  =  NAPATK  ♦  1 
IPARAL  =  KiPwTK 
945  CONTINUE 

RPTRWT  (WWTK)  =  IPARAL 
WO(SR  *  MAICIWOWSR ,  TROWS) 

< 

900  CONTINUE 

IVAL  x  10HR  WNG-TAIL 

IF  (OCCKPR)  WHT€<NT6,7D20>  IVAL, JCCL, YBAR, CL,  WOWS,  (MUAIC (1 , 
1  Wae-!*1),MUAIC<2,WCWS-IH>,  Isl.WOWS) 
c 

962  CONTI  MJE 

IF  (.NOT,  lUtm  CO  TO  1000 


CCQWX  00818 
CEQWX  00819 
C€OeX  00820 
6EQWX  00821 
CCOCX  00822 
CEQWX  00823 
ceoex  00024 
CCCWX  00825 
CE06X  00826 
ceoex  00827 
CCOWX  00828 
ceoex  00829 
ceoex  00830 
ceoex  00831 
ceoex  00832 
ceoex  00833 
ceoex  00834 
ceoex  00835 
ceoex  00836 
ceoex  00837 
ceoex  00838 
ceoex  00839 
ceoex  00840 
ceoex  oo84i 
ceoex  00842 
ceoex  00843 
ceoex  00844 
ceoex  00845 
ceoex  00846 
ceoex  00847 
ceoex  00648 
ceoex  00849 
ceoex  oo85o 
ceoex  oo85i 
ceoex  00852 
ceoex  00853 
ceoex  00854 
ceoex  (ness 
ceoex  00856 
ceoex  00857 
ueoex  00858 
ceoex  00859 
ceoex  00860 
ceoex  00861 
ceoex  00862 
ceoex  00863 
ceoex  00864 
ceoex  00865 
ceoex  00866 
ceoex  00867 
ceoex  00866 
ceoex  00869 
ceoex  006 to 
ceoex  oo87i 
ceoex  00872 

CECMDX  00873 
CCCMDX  00874 


B39 


Ann 


ms  ccmtinuc  ccoex  oobts 

H.WTK  s  M.WTK  ♦  1  CEOCX  00876 

C  OETERMIW  UH  ETHER  BOTH  SURFACES  HAVE  NO  DIHEDRAL  CEOCX  00877 

IF  (PSIW  .E4.  0.  .AW.  PSIDIF  ,EQ.  0.  .AW.  NSURF  .EC.  2)  CO  TC890  CEOCX  00878 

WPATK  =  NSPATX  ♦  1  CEOCX  00879 

RPTLWT  (H.WTK)  =  NSPATK  CECHBX  00080 

C  W5ITE  NEW  MUAIC  ARRAY  CN  SCRATCH  CEOCX  00881 

IVAL  =  10HL  VWO-TAIL  CEOCX  00882 

N  =  WCWSL  CEOCX  00883 

FARM  (4)  =  YBARL  CEOCX  00884 

RARN(S)  a  ELL  CEOCX  00885 

CALL  URTEMXUVPSC.  MXWnT.RAWOU.NFS.KMS.LS.NFR.LWS,  K,  ID.  CEOCV.  00886 

1  HUM  I  CL  i  I  TYPE,  H,N,  PARK.  IRR)  CEOCX  00887 

IF  (IRR  .NE.  0)  CO  TO  8075  CEOCX  00888 

N5CR2  =  NSCR2  ♦  1  CEOCX  00889 

IF  (CHECK PR)  V#;iTE'NT6,7D20)  I VAL, JCCL, YBARL, ELL,  W0WSL,  CEOCX  00890 

l  (MU*ICL(l,WaWLMM),MUAICL<2,WOCL-I+l),  in.fROWSL)  CEOCX  00891 

C  REINITIALIZE  THE  LEFT  MUAIC  ARRAY  CEOCX  00892 

DO  987  I  =  1 ,  NROWSL  CEOCX  00893 

MJAICL(l.I)  =  I+I  CEOCX  00894 

MUAICL(2,I>  =  0  CEOCX  00895 

987  CONTINUE  CEOCX  00896 

CO  TO  1000  CEOCX  00897 

C  OLD  MUAIC  ARRAY  HAS  BEEN  FQUW  WHICH  MATCHES  CEOCX  00398 

900  CONTINUE  CEOCX  00899 

C  USE  THE  SAME  ARRAY  FCR  RIOfT  AW  LEFT  CONTRIBUTIONS  CEOCX  00900 

KPTLWT  (F4.WTK)  =  IPARAL  CECHBX  00901 

WOHSLL  =  MAXHTROWSLL.WCVBU  CEOCX  00902 

C  CEOCX  00903 

995  CONTINUE  CECHBX  00904 

IVAL  s  1CHL  WNCr-TAIL  CEOCX  00905 

IF  (CHECK PR)  VRITE(NT6,7D20)  I  VAL ,  JCCL ,  YBARL,  ELL ,  WOWBL ,  CEOCX  00906 

1  (MUAICL(l,WCV6L-l4l).MUAia(2.W06L-l4l>,  I=1,WCW5L>  CECHBX  00907 

1000  CONTINUE  CEOSX  00908 

IF  (ISHFLW  .NE.  0)  CO  TO  1150  CECHBX  00909 

1010  CONTINUE  CEOCX  00910 

XXL  s  JCOL  ♦  1  FTNX1  00033 

IF  (JCCL  .LE.  MYBBT)  CO  TO  909  FTNX1  00034 

EW  OF  LOOP  ON  CHORDS,  FCR  WI NO- TAIL  PARAMETERS  CEOCX  00911 

CEOCX  009T2 

PUCE  AW  BUILT  UP  ARRAY  CUE  TO  PARALLEL  SURFACES  CN  SCRATCH  CECHBX  00913 

IF  (PSIDIF  .W.  0  .CR.  PSIW  .KC.  0)  CO  TO  1014  CEOCX  00914 

C  MERCE  THE  RICHT  AW  LEFT  ARRAYS  CEOCX  00915 

WOWSX  =  MIW(WCV6R,WCWSLL)  CEOCX  00916 

DO  1012  I  =  l.WCWSX  CEOCX  00917 

HUAIC(l.I)  =  HIW<  MUAIC(l.I)  ,MUAICL<1,!>  >  CEOCX  00918 

MMIC(2,I)  =  HAW(  MUAIC(2,I),MUAICL(2,I)  )  CECHBX  00919 

1012  CONTINUE  CECHBX  00920 

1014  IF  (PSIDIF  .W.  0)  CO  TO  1015  CEOCX  00921 

C  URITE  THE  ARRAY  ONTO  IWTFSC  CEOCX  00922 

IVAL  s  I0HPARAL  TAIL  CEOCX  00923 

FARM  (4)  :  YEAR  CEOCX  00924 

PARM(5)  s  EL  CEOCX  00925 

I  FARM  (S)  s  2  CEOCX  00926 

N  s  MAW (  NR0W5E.W0WSLL)  CEOCX  00927 

CALL  WITEMXUWTFSC,  MXWm,RAWOU,NF3,K'8,LS,NW,LW5,  K,  ID,  CEOCX  00923 

I  MUAIC,  l TYPE,  M,N,  FARM,  IRR)  CEOCX  00929 


B40 


IF  (IRR  .T£.  0)  GO  TO  8110 

ceoex 

00930 

»6CR  =  NSCR  ♦  1 

ceocx 

00931 

C  PLACE  THE  KPT —  ARRAYS  ON  GEOMETRY  SCRATCH  AS 

ONE  MATRIX. 

ceobx 

00932 

1015  CONTINUE 

ceoex 

00933 

IF  INSPATK  .EO.  0)  ENDFILE  I&E06C 

CEOMBX 

00934 

IF  (NSPATK  .Efl.  0>  CO  TO  2000 

ceocx 

00935 

I  FARM  (3 )  =  N*K 

ceocx 

00936 

I  FARM  (4)  =  NTTX 

ceoex 

00937 

IPARM(S)  =  TRWTK 

ccoex 

00938 

I  FARM  (6)  =  N.WTK 

ceocx 

00939 

M  =  0 

CEOCX 

00940 

c 

It 

z 

CEOCX 

00941 

IF  CNdL*  .EH.  0)  CO  TO  1030 

CEOCX 

00942 

II 

X 

CEOCX 

00943 

N  =  MJUK 

CEOCX 

00944 

DO  1020  I  =  l.NUWl 

CEOCX 

00945 

1020  KPTtl.I)  =  KFTVMd ) 

CEOCX 

00946 

1030  CONTINUE 

CEOCX 

00947 

IF  (NTTK  .EQ.  0)  CO  TO  1050 

CEOCX 

00948 

M  =  M  ♦  1 

ceoex 

00949 

N  =  MOC(N,NTTK) 

GECMBX 

00950 

DO  1040  I  =  1 ,  NTTK 

CEOCX 

00951 

1040  KPT  (M*  I )  =  KPTTTtn 

CEOCX 

00952 

1050  CONTINUE 

CEOCX 

00953 

IF  (N5WTK  .EO.  0)  CO  TO  1070 

CEOCX 

00954 

M  =  M  ♦  1 

CEOCX 

00955 

N  =  KAXOlN.NiWTX) 

CEOCX 

00956 

DO  1080  1  =  1,  MtWTK 

CEOCX 

00957 

1080  KPT  (M.  I )  =  KPTRWni) 

CEOCX 

00958 

1070  CONTINUE 

CEOCX 

00959 

IF  (N.WTK  -EQ.  0)  CO  TO  1090 

CEOCX 

00980 

M  2  M  ♦  1 

CEOCX 

00961 

N  =  MAW  (N|  N.WTK) 

ceocx 

00962 

DO  1080  I  =  l.N-WTK 

CEOCX 

00963 

1080  KPTIM.I)  -  KPTLWT <1 ) 

ceocx 

00964 

1090  CONTINUE 

ceocx 

00965 

K  =  4 

CEOCX 

00966 

IVAL  =  3HKPT 

ceocx 

00967 

CALL  VliTEMX ( I CEC6C ,  MXVRIT,  RATCOU, 

LS.TMi.LNS, 

K ,  ID, 

ceocx 

00968 

1  KPT,  I TYPE,  M,N,  PARK, 

IRR) 

CEOCX 

00969 

IF  (IRR  ,»C.  0)  CO  TO  8070 

ceocx 

009 70 

END  FILE  ICE  CSC 

ceocx 

00971 

C 

ceocx 

00972 

C  MOVE  THE  HJAIC  ARRAYS  TO  THE  CECMETRY 

SCRATCH 

TAPE 

ceocx 

0C973 

REWIK)  IWTFSC 

CEOCX 

00974 

REWIND  IVPSC 

CEOMBX 

00975 

IVAL  =  8HMUAIC 

ceocx 

00976 

M 

l» 

X 

CEOMBX 

00977 

IF  (NSCR  0)  CO  TO  1096 

CEOMBX 

00978 

DO  10*4  |  s  1 ,  NSCR 

ceoex 

00979 

CALL  RDINJT 

CEOCX 

00980 

CALL  READMXdWTFSC,  MXVRJT.RAKXXI, TTS.MMS 

,LS 

K,  NID 

,  ID, 

ceocx 

00981 

1  I TYPE,  IRS,  MUAIC,  M.N,  FARM, 

IRR) 

ceoex 

00982 

IF  (IRR  .»C.  0)  CO  TO  8100 

ceocx 

00983 

CALL  VKVCMXUCCC6C,  HXVRIT,  RANDOU, 

hfS.TWS, 

LS.N4T.LVS, 

K,  ID, 

ceocx 

00984 

1  ►KJAIC,  ITYFE,  M,N,  FARM 

,  IRR) 

ceocx 

00983 

IF  (IRR  .NE,  0)  CO  TO  6070 

ceocx 

00986 

1094  CONTINUE 

109*  If  <*eCR2  ,LE.  0)  CO  TO  1110 
DO  1100  1  =  1,N5CR2 

CALL  READMXO  VF*SC,  MXWIIT.RANDCU.NFS,  W«,LS,PM<,  K>  NID.ID. 

1  I  TYPE,  LRSi  MJAIC t  M,N,  PARM,  JRR) 

IF  (IRR  .NE.  0)  CO  TO  8090 

CALL  W5TENXUCEC6C,  MXWilT,  RAMX3U,  NFS.NMS,  LS,W*,LVe,  K,  ID, 

1  MUAICi  ITYPE,  H,N,  PARK,  IRR) 

IP  (IRR  .NE.  0)  CO  TO  8070 
1100  CCNTIMJE 
1110  CONTINUE 

END  PILE  ICE  CSC 
CO  TO  2000 
C 

C  LOOP  ON  SAMPLE  WISH  CHORDS  (USED  IP  ISMFLW  .NE.  0)  TO 

C  DETER  MI  PC  MIMIC  ARRAYS  PCR  RIGHT  ANC  LEFT  WINS  IPCLUCNCE 

C  ON  EACH  CHORD 

1120  CCNTIMJE 
NRWTK  =  0 

N.WTK  =  0 

IP  (ISMFLW  .EO.  0)  CO  TO  1015 
C  (  DO  1200  JCVRD  =  1 , 1SMPLW  ) 

X>RD  =  1 
1130  CONTINUE 

JCOL  =  ICHCRDIjCWD) 

CAM.  =  2LOC(JOKD) 

YMUVSP  -  CAPLL*SIN(PSIW) 

TRCW  *  I8QML  ( JOfiC) 

CO  TO  930 

C  THE  LOCIC  PCR  ♦  TAIL  CHORD  IS  USED.  AFTER  THE  MIMIC  ARRAYS 

C  ARE  CCTERMI PCD  AM!  STORED,  CONTROL  IS  RETLRPCD  TO  THIS  LOOP. 

1190  CONTINUE 
1200  COWTIM/ 

XHRD  r  JORD  ♦  1 
IP  <JO*D  .LE.  ISMPLW)  CO  TO  1130 
C  EM)  CF  LOOP-  ON  SAMPLE  WISH  CHORDS 

C 

CO  TO  1013 
C 

2000  CONTINUE 

END  FILE  ICEC6C 
REWIND  ICE  CSC 
REWIM)  1 WTFSC 
REWIND  IVPSC 
RETURN 

C 

c  OUTPUT  PCR  MATS 

C  CARD  P 

6010  PCR  MAT  (IH0.1SX.39H - CEOCTRIC  PARAMETERS - / 

1  1H0.29HCARDP  -LOCAL  AXES  DEFINITION-, 

2  4X,  10MX-LCCATICN,  4 X,  10HZ-L0CATI CN,  4X, 

2  mplHCDRAL  ANCLE  (PSD  /  2TX.5HWINC  ,  F10.3.4X,  F10.3,  8X, 

J  .2,  8H  DECREES  ) 

6012  PC-  HATCJTX, 5HTAIL  ,  P10.3.4X,  P10.3,  8X,  FT. 2,  8H  DECREES  ) 

C  CARD  C 

6013  PCR  MAT  (IHOiSOHCARDC  -BOX  PATTERN  CEFINt  TIO*-  ,  5X,  6HNXRDS ,  10X, 

t  6HXCFWTR  ,  5X,2HCR  ,4  X,  5HXCC0C  /37X,  13,  «X,  P10.4,  6X.F10.4  ) 


ccocx 

0098T 

ccoex 

00968 

CEQMIX 

00980 

ccoex 

00990 

ccoex 

00991 

ccoex 

00992 

ccoex 

00993 

ccoex 

00994 

ccoex 

00995 

ccoex 

00996 

ccoex 

00997 

ccoex 

00998 

ccoex 

00999 

ccoex 

01000 

ccoex 

01001 

ccoex 

01002 

ccoex 

□1003 

ccoex 

01004 

ccoex 

01005 

ccoex 

01006 

ccoex 

01007 

FTNXl 

□0035 

FTNX1 

00036 

FTNXl 

00037 

ccoex 

01009 

ccoex 

01010 

ccoex 

01011 

ccoex 

01012 

ccoex 

01013 

ccoex 

01014 

ceoex 

01015 

ccoex 

01016 

ccoex 

01017 

FTNXl 

00038 

FTNXl 

00039 

ccoex 

01018 

ceoex 

01019 

ccoex 

01020 

ccoex 

01021 

ccocx 

01022 

ceoex 

(102"! 

ccoex 

01024 

ccocx 

01025 

CCOTX 

01026 

ccoex 

01027 

ccoex 

u  1  Geo 

ccoex 

01029 

ccoex 

01030 

ccoex 

01031 

ccoex 

01032 

ccoex 

01033 

ccoex 

01034 

ccoex 

01035 

ccoex 

01036 

ccoex 

01037 

ccoex 

01 03*1 

ccoex 

01  Vi  7 
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•017  FORMAT  If  x,  13H- SAMPLE  WASH, 13,  8H  CHORDS-,  5X,6Ht  CHORD,  6X.3HIBOKF,  CEOCX  01040 

1  SX.9H1BOL,  «X,  4HZL0C  /(3TX,  13, SX,  13,  7X,  13,  SX,  77.2  )  )  StOCX  01041 

C  CARD  H  GEOCX  01042 

•0C1  FORMAT  (1H0.40HCARGH  -PLAPFCRM  DEFINITION  701  NT  COUNTS-, SX,  CEOCX  01043 

1  12HLEA0INC  EDGE,4X,13HTRAILING  EDGE  /42X.4HWING,  17,  9X,  17  )  CEOCX  01044 
•022  FORMAT (42X.4HTAIC,  I7.9X.I7)  CEOCX  01049 

C  CARDS  I  TO  L  CEOCX  01046 

•029  FORMAT <!H0 , 37HCARDI  TO  CAROL  -PLAPfCRM  DEFINITIONS- ,9X,1HX,9X,1WY ,  GECMBX  01047 
1  4X.12H  (LOCAL  AXES)  )  CEOCX  0104S 

•030  FORMAT!  32X.A10.  F9.3,  F10.3/  (4tX,2F10.3>)  CEOCX  01049 

•040  FORMAT  (1H0, 7x.  31H-B0X  £  I XX I OKB-  SI  (LENGTH)  =  .  E18.8,SX,  CEOCX  01090 

1  17HB1/BETA  (WIDTH)  *,  E18.8)  CEOCX  01031 

CEOCX  01092 

CHECK  PRINT  FORMATS,  USED  CN.Y  WIEN  CHECH?  =  .T.  CEOCX  01093 

RMO  FORMAT U9H0IWAKE  ARRAY  -  ,  4013  /  (19X.40I3)  >  CEOCX  01094 

1020  FORMAT (1TH0MUA I C  ARRAY  FOR  ,A1Q,  8H,  CHORD  12,  9H,  YBAR  *  F8.3,  CEOCX  01093 

1  7H,  EL  =  F7.2  /  SOX,  3AC0W.  13,214  /  (16X.2I4)  )  CEOCX  01036 

1030  FORMAT C51H0  IJAL HI  (s  J*1000  ♦  I  OCTAL)  AND  ALPHA  ARRAYS,  AS  GEOCX  01037 

1  TM  STORED  /  6<  SX.13HI  JALHi  ALPHA  )  /  (6(3X,C6,  FT. 4)  >  )  CEOCX  01058 

1040  FORMAT (21  HO  CHECX  PRINT,  PEH.OC/  (10F12.7) )  CEOCX  01099 

1049  FORMAT!  1HD  14X,  GHTCSLOC  /  (10F12.7)  )  CEOCX  01060 

CEOCX  01061 

DIACNOSnC  FORMATS  CEOCX  01062 

8010  FORMAT (S2H044*  WARNING  -  XEDGE  AND  XCENTR  VERE  BOH  SPECIFIED.  GEOCX  01063 

1  26H  XBCCE  WILL  BE  IGNORED  44*  )  GEOCX  01064 

8020  FORMAT (4JM044*  WARNING  -  SAMPLE  WASH  SPECIFICATION  SET  12, CH  IS  IN  GEOCX  01069 
1  35H  ERROR.  CN.Y  THE  PRECEDING  OCS  WILL  BE  CALCULATED  44*  )  GEOCX  01066 

9030  FORMAT (53HQ44*  WARNING  -  SAMPLING  OF  UPWASHES  CAPNOT  BE  DOC  IF  GEOCX  01067 

1  39H  A  TAIL  HAS  BEEN  DEFINED.  ISMPLW  =,13,101  WILL  BE  IGNORED  GEOCX  01068 

2  4H  44*  )  CEOCX  01069 

9110  FOIMAT (23HQ*4*  ERROR  -  PARAMETER  .A6.23H  WAS  NOT  SPECIFIED.  IT  GEOCX  01070 

1  29H  MUST  ALWAYS  BE  GIVEN  44*  )  GEOCX  01071 

9120  FORMAT  (53H044*  ERROR  -  EITHER  ttDGE  CR  XCENTR  MUST  BE  SPEC  I  RED  CEOCX  01072 

1  4H  44*  )  GEOCX  01073 

9130  FORMAT (13H044*  ERROR  -  ,A6,29H  IS  OUTSIDE  ALLOWED  RANGE  44*  )  CEOCX  01074 

9190  FORMAT  (13H04*4  ERROR  -  .A10.23HDEFINITICN  POINTS  ERROR,  13,  CEOCX  01079 

1  29H,  A  COPCI  NATION  OF-  44*  /  13X.24H1,  NOPP-MCNOTONIC  Y-VALUE  GECMBX  01076 

2  1HS.  10X.29H2,  NOPP-MONOTCNIC  X- VALUES  /  13X.11H4,  FIRST  Y-  CEOCX  01077 

3  14H VALUE  POP-ZERO,  10X.34H8,  TIP  T.E.  Y-VAL'JE  DISAGREES  WITH  CEOCX  01078 

4  19M  TIP  L.E.  VALUE  >  CEOCX  01079 

9180  FORMAT (31H044*  ERROR  -  XCENTR  POT  WITHIN  90  BOX  LENGTHS  (B1  *  ,  CEOCX  01060 

1  03.8,200  OF  THE  WING  L.E.  (,E19.8,  SH>  44*  )  GEOCX  01061 

81  ID  FORMAT (92H044*  ERROR  -  WOLE  WRITING  ON  GEOMETRY  SCRATCH  FILE  A10,  GEOCX  01082 

1  19H,  ERROR  CODE  s  14,  4H  *4*  )  GEOCX  01063 

8172  F0RMATO4X,  EHARRAY  ,A6,19H,  DIMENSIONED  (I4.1H,  14.11H)  WAS  BEING  GECMBX  01084 

1  8M  WJITTEN  >  CEOCX  01085 

8179  FQRMAT(14X,20HTHE  MUAIC  ARRAY  FOR  A10.19H,  DIMENSIONED  (I4.1H.I4,  CEOPCX  01086 

1  19H)  WAS  BEING  WtITTCN  )  CEOCX  01087 

9180  FORMAT  (92H0  4*4  ERROR  -  THE  TAIL  A  PC  WING,  OR  THEIR  DIAPHRAGMS,  GEOCX  01088 

1  28W  CROSS  -  ABOVE  TO  BELOW  444  )  GEOCX  01089 

9190  FORMA H34H04**  ERROR  •  WULC  READING  FROM  GEOMETRY  SCRATCH  FILE  GEOCX  01090 

1  A10.19H,  ERROR  CODE  *  14,  4H  44*)  GEOCX  01091 

9192  F0RMATO4X,  EHARRAY  .A6.19H,  DIMENSIOPCD  (I4,1H,I4,UH>  WAS  BEING  GEOCX  01092 

1  9H  REA!)  )  GEOCX  01093 

C  GEOCX  01094 

C  ERRORS  -  ALL  ERRORS  CALL  FLUSH  GEOCX  01095 

•010  CONTINUE  GEOCX  01096 
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VRITE  (NTS, 9110)  IVAL 
60  TO  8900 
8015  CONTINUE 

VRIT E  (NT6,9130)  IVAL 
60  TO  8900 
8020  CONTINUE 

VRITE  <NT6,9120> 

SO  TO  8900 
8030  CONTINUE 

VRITE  (NT6.9130)  IVAL 
60  TO  8900 
8040  CONTINUE 
60  TO  6900 
8050  CONTINUE 

VRITE  (NT6.9150)  IVAL,  IRS 
60  TO  8900 
8060  CONTINUE 

VRITE  (NT6,9160>  B1 ,  XEECEW 
60  TO  8900 
80 TO  CONTINUE 

VRITE  (NT6.91T0;  IGE06C,  IRR 
VRITE  (NT6.91T2)  IVAL,  M.N 
60  TO  8900 
8073  CONTINUE 

VRITE  (NT6.917D)  IVPSC.IRR 
'RITE  (NT6.9175)  IVAL,  M.N 
60  TO  8900 
8080  CONTINUE 

VRITE  (NT6.9180) 

60  TO  8900 
8090  CONTINUE 

VRITE  (NT6.9190)  IVPSC.IRR 
VRITE  INT6.9192)  IVAL,  M.N 
60  TO  8900 

8100  VRITE  (NT6.9190)  IWTFSC,  IRR 
VRITE  (NTS, 9192)  IVAL.  N.N 
60  TO  8900 

8110  VRITE  (NT6.91TQ)  IWTFSC, IRR 
VRITE  (NT6.9175)  IVAL.  M, N 
8900  CALL  FLUSH  (1) 

oe 


CEOCX 

6ECMBX 

6EOCX 

6C0MQX 

6EOCX 

6E06X 

CEOCX 

6EO€X 

CEOCX 

6COCX 

6ECM3X 

6E06X 

6ECMBX 

GE06X 

CEOCX 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

CEOBX 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 

ceoex 


01097 

01098 

01099 

01100 

01101 

01102 

01103 

01104 

01105 

01106 

01107 

01108 

01109 

onto 

01111 

01112 

01113 

01114 

01116 

01116 

01117 

01118 

01119 

01120 

01121 

01122 

01123 

01124 

01125 

01126 

01127 

01126 

0tl29 

01130 

01131 

01132 

01133 

01134 

01135 

01136 

01137 
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SUBROUTINE  EDCCHMXEDGE.YEDGE, HEDGE,  IEDGE,  IRR) 

EDGCHK 

00002 

c 

EDGCHK 

npOCft 

c 

CHECKS  FCR  MQNOTOWC  EDGE  VALUES  CF  X  FCR  LEADING  EDGES,  AM) 

EDGCHK 

00004 

c 

V  FOR  EITHER  LEAD I NO  CR  TRAILING.  CHECKS  Y  FIRST  AM)  LAST 

EDGCHK 

00005 

c 

VALUES  TO  ENSURE  DEFINITION  FROM  CENTERLINE  TO  TIP 

EDGCHK 

ooooe 

c 

«3>5E  s  X- VALUES  FOR  OC  PLAKFCRM  EDGE 

EDGCHK 

00007 

c 

YEDCE  =  V- VALUES 

EDGCHK 

ooooe 

c 

HEDGE  s  NUtCER  OF  OCEDGE.YEDGE)  SETS  DEFINING  THE  PLAN- 

EDGCHK 

00009 

c 

FCRM  EDGE 

EDGCHK 

00010 

c 

I EDGE  3  1  FCR  LEADING  EDGE,  2  FCR  TRAILING  EDGE 

EDGCHK 

00011 

c 

IRR  »  ERRCR  RETURN,  0  SUCCESSFUL 

EDGCHK 

00012 

c 

t,  NONMONOTONIC  Y-VALUES 

EDGCHK 

00013 

c 

2,  NON-MCNOTOaC  X- VALUES,  LEADING  EDGE  OLY 

EDGCHK 

00014 

c 

4,  FIRST  V-VALUE  NONZERO 

EDGCHK 

00013 

c 

8,  TIP  Y- VALUE  CF  A  T.E.  DISAGREES  WITH  PREVIOUS  EDGCHK 

00016 

c 

LoE.  TIP  VALUE 

EDGCHK 

oooi  r 

c 

EDGCHK 

00018 

DIMENSION  XEDGEd).YESGE(l) 

EDGCHK 

00019 

c 

EDGCHK 

nnrcNi 

IRR  *  0 

EDGCHK 

00021 

IF  (YEDGC(l)  .NE.  0.  )  IRR  s  4 

EDGCHK 

00022 

DO  100  I  s  2,tOGE 

ED  COM 

00023 

IF  CYEDCCU)  .LT.  YEDGE(I-l)  )  GO  TO  150 

ED  COM 

00024 

GOTO  (50,100),  I EDGE 

EDGOM 

00025 

50  IF  OCDCCU)  .LT.  XEDGE(l-l)  )  GO  TO  200 

EDGOM 

00026 

100  CONTINUE 

EDGOM 

0002? 

GO  TO  290 

EDGOM 

00028 

150  IRR  *  IRR  ♦  1 

EDGOM 

00029 

GO  TO  290 

EDGOM 

00030 

2D0  IRR  3  IRR  ♦  2 

EDGCHK 

00031 

290  CONTINUE 

EDGOM 

00032 

GOTO  000,390), IECGE 

EDGOM 

00033 

900  YTIP  s  YEDCE  (HEDGE) 

EDGOM 

00034 

GO  TO  900 

EDGOM 

00035 

390  IF  (YEDCEOCDCE)  .HE.  YTIP)  IRR  3  IRR  a  0 

EDGOM 

00036 

c 

EDGOM 

00037 

900  RETURN 

EDGOM 

nrrrxfl 

c 

EDGOM 

00039 

DC 

EDGOM 

rnrwi 
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SUBROUTINE  eDGCHKOCEDCe.YEDCe, HEDGE, lEOGE, IRR) 

EDGCHK 

00002 

c 

EDGCHK 

00003 

c 

CHECKS  FCR  HONOTOWC  EDGE  VALUES  CF  X  FCR  LEADING  EDGES,  AM) 

xDCCHK 

00004 

c 

Y  FCR  EITHER  LEADING  CR  TRAILING.  CHECKS  Y  FIRST  AM)  LAST 

EDGCHK 

00005 

c 

VALUES  TO  ENSURE  DEFINITION  FROM  CENTERLIMI  TO  TIP 

EDGCHK 

00006 

c 

XEDGE  s  X- VALUES  FCR  C»€  FLANFCRM  EDGE 

EDGCHK 

00007 

c 

YEDCE  s  Y- VALUES 

EDGCHK 

00000 

c 

M3)Ce  =  NUMBER  CF  (XEDGE, YEDCE)  SETS  DEFINING  THE  PLAN- 

EDGCHK 

00009 

c 

FCRM  EDGE 

EDGCHK 

00010 

c 

I EDGE  =  1  FCR  LEADING  EDGE,  2  FCR  TRAILING  EDGE 

EDGCHK 

00011 

c 

IRR  s  ERROR  RETURN,  0  SUCCESSFUL 

ED  GO»( 

00012 

c 

1,  NON-MONOTCNIC  Y- VALUES 

EDGCHK 

00013 

c 

2,  NCN-MCNOTOflC  X- VALUES,  LEADING  EDGE  CK.Y 

EDGCHK 

00014 

c 

4,  FIRST  Y-VALUE  NON-ZERO 

EDGCHK 

00019 

c 

8,  TIP  Y-VALUE  CF  A  T.E.  DISAGREES  WITH  PREVIOUS  EDGCHK 

00016 

c 

LpE.  tip  value 

EDGCHK 

00017 

c 

EDGCHK 

00018 

DDOSICN  XEDCE(l)  ,YEDGE«) 

EDGCHK 

00019 

c 

EDGCHC 

00020 

IRR  *  0 

EDGCHK 

00021 

IF  (YEDGC(l)  ,»C.  0.  )  IRR  =  4 

EDGCHK 

00022 

DO  100  I  =  2.MDGE 

EDGCHK 

00023 

IF  (YEDCEU)  .LT.  YEDCE(I-l)  )  GO  TO  ISO 

EDGCHK 

00024 

GO  TO  (90,100),  1EDGE 

EDGCHK 

00025 

90  IF  OCDCE(I)  .LT.  XEDCE(I-l)  )  GO  TO  200 

EDGCHK 

00026 

100  CONTINUE 

EDGCHC 

00027 

GO  TO  290 

ED  Gem 

00020 

190  IRR  *  IRR  ♦  1 

EDGCHK 

00029 

GO  TO  290 

EDGCHC 

00030 

2D0  IRR  a  IRR  ♦  2 

EDGCHK 

00031 

290  CONTINUE 

EDGCm 

00032 

GOTO  <300,390) ,  I  EDGE 

ED  Gem 

00033 

300  YTIP  =  YEDGE(MDGE) 

EDGCm 

00034 

GO  TO  900 

EDGCm 

00035 

390  IF  TYEDGEINEDCE)  .»€.  YTIP)  IRR  s  IRR  ♦  8 

EDGCm 

00036 

c 

EDGCHC 

00037 

900  RETURN 

EDGCm 

00038 

c 

EDGCHK 

00039 

CM) 

CDCcm 

00040 
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II  *  IS  ♦  I  DCCCER 

1000  CONTINUE  DC  COER 

CO  TO  9000  DC  CCER 

DC  COER 

mOOUH  WIU.  RETRIEVE  HJ  BOXES  FROM  OKRD  J  DC  COER 

1100  CONTINUE  DC  CCER 

41  *  <J-l)/tCWiD  ♦  1  DC  CCER 

JB  a  (NMD  -  MCOlJ.tCVftO)  )  *  9  DC  CCER 

IF  (JB  .E|.  00)  JB  s  0  DC CCER 

IJHtSX  a  SHI  ET  (MASK  ,JB>  DC  CCER 

NJB  s  -JB  DCCCER 

DO  2000  II  s  MEND,  ISM  P  DC  CCER 

IJWCRD  3  IBOKdl  i  J9B)  DCCCER 

IJCODE  a  I  JWCRD.AMl.I  JMASK  DC  ODER 

I  COCCUS)  3  SHIFT(t  JCCCEiNJB)  DCCCER 

II  s  IS  ♦  1  DCCCER 

SOOO  CONTINUE  DCCCER 

C  DCCCER 

9000  CONTINUE  DCCCER 

RETURN  DCCCER 

DC  DCCCER 


00055 
00056 
000S7 
00056 
00059 
00060 
00061 
000 G2 
00063 
00064 
00065 
00066 
00067 
00066 
00069 
00070 
00071 
0007? 

00073 

00074 

00075 


M? 


c 

c 

c 

c 

c 

r- 

c 

c 

c 

c 

c 


SUBROUTINE  NCCCER <1  BOX , LBOX ,  IA.JA,  IL.  ICCCE  I  NCCCER  00002 

COCmiCN  I  BOX  (LB  OX,  1)  NCCCER  00005 

NCCOER  00004 

ENCODES  OC  INTEGER  BOX  CODE  INTO  THE  PACKED  CODE  ARRAY  ALCNG  a  NCCCER  00005 
PCSTICN  or  A  CHORD i  REPLACING  fREVIOUS  VALUES  NCCCER  00006 

NCCCER  00007 


I  BOX  -  ARRAY  OF  BOX  CCCES.  PACKED  20  PER  VCRC  NCCCER  00008 
LBOX  -  ROM  DIMENSION  OF  BOX  COCES  ARRAY  NCCCER  00009 
IA  -  I-TH  IECEX  CF  FIRST  BOX  COCE  TO  SET  NCCCER  00010 
JA  -  J-7H  ITCEX  OF  FIRST  BOX  CCCE  TO  SET  NCCCER  00011 
IL  -  I-TH  INDEX  OF  THE  LAST  BOX  CCCE  TO  SET  NCCCER  00012 
I  CCCE  -  CCCE  VALUE,  1,2,  CR  3,  FCR  THE  NCCCER  00013 

NCCCER  00014 


INTEGER  SHIFT 

DATA  MASK  /  77777777777777777770B  / 
DATA  NBVRD  /20/ 

JSS  a  (JA-D/KEVRD  +  1 

JB  a  tfBVRD  -  MOCtJA.TCVRD)  )  *  3 

IF  (JB  .ED.  60)  JB  =  0 

JB  =  A  LEFT  SHIFT  COUNT 
I  CCD  a  SHIFT (ICCCE,  JB) 

IJmSK  =  SHIFT  <mSK,JB) 

DO  100  II  =  IA.IL 
I J CCCE  a  I JMASK  .AH).  IBOXUI.JSB) 
100  IBCKIII , JSB)  =  IJCCCE  .CR.  ICCC 
RETURN 
END 


NCCCER  00013 
NCCCER  00016 
NCOCER  00017 
NCOCER  00018 
NCCCER  00019 
NCCCER  00020 
NCCCER  00021 
NCCCER  00022 
NCCCER  00023 
NCCCER  00024 
NCCCER  00025 
NCCCER  00026 
NCCCER  00027 
NCCCER  00028 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTIFC  PRNTBC  (I BOX, LBXCD,  IPRST, IUST,  JUST,  SUBD) 

DIMENSION  IBOX(L8XCD,1>,ICCCE(150> 

LO&ICAL  SUED 

PRINTS  BOX  CODES,  SUBDIVIDED  CR  UFCUBBIVIDED 
I  BOX  -  COMPRESSED  BOX  CCCE  ARRAY 
LBXCD  -  ROW  DIMENSION  OF  BCY  CCCE  ARRAY 
IPRST  -  FIRST  ROW  DESIRED  TO  PRINT 
IUST  -  UST  RON  DESIRED 

JUST  -  UST  CHORD  DESIRED  (FIRST  IS  ALWAYS  ONE) 

SUED  -  .T.,  SUBDIVIDED  CODES  DESIRED 
.F.,  UK6UBDI  VICED  CODES  DESIRED 

CO840N  /CECKTY/  CCfUN,  NSUBDV ,  XSUBDV ,  NSUBC2 ,  N5UBCN,  NSURF , 

1  Bl, BIBETA, BIS, BIBTAS.VLAX.VLAZ.PSIW. 

2  MXBW.  MXBBW,  Ml'BVJ,  MfBBW,  MXBSW,  MTBSW,  WBBSW, 

3  IXBW,  XCENTR 
LOGICAL  COPUN 

CO04CN  /CCNTRL/  FREVEX.CMACH,  TITLE (8) ,  FRVGECM,  FRVHCCE,  DIHW,  DIHT, 
1  DEFAULT 

LOGICAL  FRVGECM, FRVHCCE, DIHW, DIHT, DEFAULT 

0CM40N  /FRCBLM/  XVVkCH,  NMCCES,  NTSL OP, MO VALS, SMOOTH, PCEG.CR CRT, 

1  EXAICiSUEDV,  FLYWOCC 

LOGICAL  SMOOTH ,  GcDFT  T ,  EXAICiSUEDV,  FL.YWOCC 

COWON /FILES  /  Nr5,NT6,INrAPE,IffSP,NFUIC,NSFAIC,NaUTP, 

1  ICXJF5P.MCCESC,IVPSC,IGEC6C,IWTF5C,IAICSC 

DIMENSION  BCD (4) 

INTEGER  BCD 

DATA  BCD/  1H  ,1H1,1H2,1K3  / 

DATA  PCVRD  /20  / 

8001  FCRMAT (1H1 ,  5X,8A10/lHD,20X,16HBCi(  CCCE  PATTERN  ) 

8002  FORMAT (19X.20HFCR  SUBDIVIDED  BOXES, 25X,  WIXBW  =,  12, 11H  (SUBDIVID 
1  30HED  ROW  OF  UNSUBDIVIDED  CENTER)  ) 

8005  FORMAT  (22X,4HMACH,F11 .7.56X,  *C.CCE  -  1  =  FLA  Tf CRM  BOX*  / 

1  19X,20(lH->,61X,*e  =  DIAPHRAGM  BOX*  /100X,*3  =  WAKE  BOX  *  ) 

8010  FOR  MAT  (IPO,  4X,  31 14  /  (  9X.30I4)  ) 

8012  FORMAT  (IH  ) 

8D20  FORMAT (IX,  I3,2X, 63A2  /  (I2X,60A2)  ) 


VRITE  (NTS, 8001)  TITLE 
IF  (NSUBDV  .BO.  1)  CO  TO  100 
IF  (.NOT.SUBD)  GO  TO  100 
VRITE  (NT6.6002)  IXBW 
100  CONTINUE 

WTtTE  <NT6, 6005)  XMACH 

tfilTC  (NT6.6010)  (I,  1=2, JUST, 2) 

WRITE  (NT6.8012) 

DO  230  IROW  =  IPRST,  IUST 

CALL  DC  CCER  (I  BOX,  LBXCD,  IROW.l,  IRCW, JUST,  SUED,  ICCCE  ) 
CHANGE  INTEGER  CODES  TO  ALPHANUMERIC 


C 

c 

c 


DO  200  J*  1 ,  JUST 
IF(lCOCE(J),Ea.O) 
ifucccC(j)  .ca.n 
if  (iccoc(j)  .ea.2> 


ICOCE  (J )  =  BCD  (1 ) 
ICCCC(J>  =  BCD(2> 
ICCCE  (J)  =  BCD  (3) 


FRNTBC 

PRNTBC 

PRNTBC 

PRNTBC 

PRNTBC 

PRNTBC 

FRNTBC 

PRNTBC 

PRNTBC 

PRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

CECKTY 

GECMTY 

GECMTY 

GECMTY 

GECMTY 

CCNTRL 

CCNTRL 

CCNTRL 

PRCBLM 

FRCBLM 

FRCBLM 

FILES 

files 

PRNTBC 

FRNTBC 

FRNTBC 

FTNX1 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

PRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 

PRNTBC 

FRNTBC 

FRNTBC 

PRNTBC 

FRNTBC 

FRNTBC 

PRNTBC 

PRNTBC 

FRNTBC 

PRNTBC 

FRNTBC 

FRNTBC 

FRNTBC 


00002 
00003 
00004 
00005 
00006 
OOOOT 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00002 
00003 
00004 
00005 
00006 
00002 
00003 
00004 
00002 
□0003 
00004 
00002 
00003 
00020 
00021 
00022 
00040 
00023 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
00032 
00033 
OCO  34 
00035 
00036 
00037 
00038 
00039 
00040 
00041 
00042 
00043 
00044 
OCO  4  5 
00046 
00047 
00040 
00049 
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ircjCCCEO)  .Efl.3)  ICCCEU)  =BCE<4)  CKNTBC  00050 

2D0  CCHTIH*  fRNTBC  00051 

WITE  (MTS, 6020)  IRCW,  (ICCCE(J),  J  =  1 ,  JIAST  )  WRNTBC  00052 

*»  CCNT1^  *KTBC  00053 

RCrUiN  fRtCBC  00054 

°®  PRNTBC  00055 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  BXCDPF  OG.E*  YLE,  H.E, XTE,  YTE, NTE,  LSRCM5.IBOX  ) 

BXCDPF 

00002 

BXCOPF 

00003 

COCRATES  WE  BOX  CCCE3  FOR  WE  CN-PLANFCRM  BOXES  CF  ONE 

BXCDPF 

00004 

surface. 

BXCDPF 

00003 

INPUT  PARAMETERS 

BXCDPF 

00006 

*.E 

=  X- VALUES.  LEADING  edge,  NQN-CltCNSICNAL 

BXCDPF 

OOOOT 

TLE 

=  Y« VALUES,  LEADING  EDGE 

BXCDPF 

00009 

H.E 

=  NUHJER  OF  LEADING  EDGE  POINTS 

BXCDPF 

00009 

XTE 

=  X- VALUES,  TRAILING  EDGE 

BXCDPF 

00010 

YTE 

=  Y- VALUES,  TRAILING  EDGE 

BXCDPF 

00011 

NTE 

=  NUMBER  OF  TRAILING  EDGE  POINTS 

BXCOPF 

00012 

L  SR  CVS 

=  MAXIMUM  NLM5ER  OF  SUBDIVIDED  ROW5  ALLOWED 

BXCDPF 

00013 

BXCDPF 

00014 

OUTMT  PARAMETERS 

BXCDPF 

00013 

BXCDPF 

00016 

IB  OK 

=  COMPRESSED  BOX  CCCES,  SET  1  FOR  FLAfFCRM  BOXES, 

BXCDPF 

00017 

UNCHANGED  ELSEWHERE 

BXCDPF 

00018 

BXCDPF 

00019 

CO*Oi  /FILES  / 

NTS,  NT6,  INTAPE,  IPCSP.  NPUIC.NSPAIC.MDUTP, 

FILES 

00002 

t 

lOUFSP.MCCESC, I VPSC, I GEOSC, IWTFSC, IAICSC 

FILES 

00003 

COMMON  /CECKTY/ 

COfLAN,  NSUBDV,  XSUBDV,  NSU8C2 ,  NSUBCN,  T6URF, 

CECKTY 

00002 

1 

B1 , BIBETA , B1 S , B1 BTAS ,  W-AX ,  VLAZ , PSI W, 

GECMTY 

00003 

2 

MXSW,  MXBBW,  MYBW,  MTBBW,  MXBSW,  MYBSW,  MYBBSW, 

CECKTY 

00004 

3 

IX8W.XCENTR 

GECMTY 

00005 

LOCI  CAL  COPLAN 

CECKTY 

00006 

CQ+tGN  /CEOC  / 

TLAX,  TLAZ ,  PSIT,  MXBT ,  MTBT ,  WBBT ,  MXBST ,  MfBST , 

GEOC 

00002 

t 

HTBBST ,  HOT ,  I XBST ,  CAN. 

CEOC 

00003 

COMMON  /EDGES  / 

FE*.0C(250>,  TEXLOC 1250) ,  JCIAG 

EDGES 

00002 

BXCDPF 

00024 

LOGICAL  WING 

BXCDPF 

DG025 

DIMENSION  *LE(1) 

i,YLE(l),XTE(l),YTE(l) 

BXCDPF 

00026 

DItCNSICN  IBCK(LSRCM5,1) 

BXCDPF 

00027 

BXCDPF 

00028 

IWUT  CO*4CN  PARAMETERS  - 

BXCDPF 

00029 

IXST 

=  SUBDIVIDED  ROW  CF  FIRST  UNSUBCI VICED  BOX  CN  TAIL  BXCDPF 

00030 

NSUBDV 

=  (INTEGER)  NLH5ER  CF  SUBDIVISIONS 

BXCDFF 

00031 

XSUBDV 

(REAL) 

BXCDPF 

00032 

NSUB2 

=  NSUBDV/? 

BXCDPF 

00)33 

NSUBCN 

=  NSUBDV/2  rt  ,  CENTER  SUBDIVIDED  BOX 

BXCDPF 

00034 

BXCDPF 

00035 

IN/OUT  COMMON  PARAMETERS  - 

BXCDPF 

00036 

IXBW 

=  0,  WING  BEING  CONE,  CHA! GED  TO  SUBDIVIDED  ROW 

BXCDPF 

00037 

CF  FIRST  ^SUBDIVIDED  BOX  CENTER  ON  WING 

BXCDPF 

00038 

.HE.  0,  TAIL  BEING  DOC,  NOT  CHANGED 

BXCDPF 

00039 

BXCDPF 

00040 

OUTPUT  CCtMOM  PARAMETERS  - 

BXCDPF 

00041 

MXBSW 

*  NUMBER  OF  SUBDIVIDED  ROWE  TO  AFT  END  OF  (WING) 

BXCDPF 

00042 

MXSST 

(TAIL) 

BXCDPF 

00043 

NYflSW 

=  NUMBER  CF  SUBDIVIDED  CHORDS  ON  WE  (WING) 

BXCDPF 

00044 

MTBST 

(TAIL) 

BXCDPF 

00045 

MXSW 

*  NUWJER  OF  UNSt/JDI VIDEO  RCV8  ON  (WING) 

BXCDPF 

00046 

MX8T 

(TAIL) 

BXCDPF 

00047 

NYBW 

*  NUt«ER  CF  UNSUBDIVIDED  CHORDS  ON  WE  (WING) 

BXCDPF 

00048 

MYBT 

(TAIL) 

BXCDPF 

00049 

fcaloc 

s  ARRAY  OF  (LEADING)  EDGE  X-LOCATIONS,  SUBDIVIDED 

8XCDPF 

00050 

T"XLOC 

(TRAILING) 

BXCDPF 

00051 

6XCCPF 

00052 
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MX*S  =  0 

DEL  =  1 ,0/XSUBDV 

LOCATION  Cf  FIRST  CHCRD 
THIN  =  .5*(1 .0  ♦  DEU 

SLOPES  CF  FIRST  LEADING  AW  TRAILING  EDGE  SECWNTS 

*en.e  =  wm 

YREPLE  =  TLE(l) 

XREFTE  =  XTE(l) 

TREFTE  =  TTE(I) 

DQ.E  =  (WE(2)-)REFLE)  /  (YLE(2)-YREFLE) 

OELTE  =  (XTE(2)-*EFTE)  /  (YTE(2)-YREFTE) 

ILE  =  2 
ITt  =  2 
I ERR  =  0 

WAS  THIS  CALL  FCR  WW  CR  TAIL  - 
IF  (IX8W  .EB.  0)  GO  TO  120 
SET  UP  COUNTERS  FCR  TAIL 
SURF  =  4HTAIL 
VANG  r  .F. 

HTBT  =  IFIX(YL£(WE)) 

NSCHRD  =  MYBT  *  N5UBCV 
JD4.0C  r  WBW  *  N5UBDV  ♦  1 
1XB  =  IXBST 
LSRR  =  LSRO-6 

IF  (.NOT.  COPLAN)  LSRR  =  t.SRR  ♦  IXBST  -  1 
CO  TO  130 

SET  UP  COUNTERS  FCR  WING 
120  CCNTIMX 

SURF  =  4HWING 
VANG  =  .T. 

NSCHRD  =  NTBW  *  J6UBDV 
JEM.OC  =  1 

MN  s  NSEFLE  ♦  (VMIN-YREFl.E)*CELE 
IX8W  s  (t.-XMIN)*XSUBDV  ♦  1 
IT®  =  1 
LSRR  =  LSRCW5 


;  START  LOOP  CN  SUBCI VICED  CHORDS 

130  CCNTIMJE 

YOKRD  3  THIN 
00  350  JCHRD  =  1, NSCHRD 
:  FIND  LEADING  EDGE  CF  THIS  CHCRD 

ICO  CCHTINlE 

c  IS  THE  CLRRENT  L.E.  SEGMENT  STILL  GOCC  - 

IF  CTCHCRD  -  YLE(SLE))  180i170i1J0 
c  NO,  ANOTHER  SEGMENT  IS  WEE  Lb 

150  CONTINUE 

YREFLE  s  YLE(ILE) 
ile  -  ILC  ♦  1 

c  XECX  F<R  EXCEEDING  UNIT 

IF  .LC  .GT.  WE)  GO  TO  *10 

C  HECK  FCR  EDGE  SEGMENT  PARALLEL  TO  (SKIP  THE  SEGMENT)  CR 

C  CUTTING  BACK  TOWARD  CENTER-LIW  (ERROR) 

IF  (TREFLE  -  YLE(ILE))  160,150,730 
C  SEGMENT  HAS  POSITIVE  SLOPE 


BXCDPF  00053 
BXCDPF  00054 
BXCDPF  00055 
BXCDPF  00056 
BXCDPF  00057 
BXCDPF  00058 
BXCDPF  00059 
BXCDPF  00060 
BXCDPF  00061 
BXCDPF  00062 
BXCDPF  00063 
BXCDPF  00064 
BXCDPF  00065 
BXCDPF  00066 
BXCDPF  00067 
BXCDPF  00068 
BXCDPF  00069 
BXCDPF  00070 
BXCDPF  00071 
BXCDPF  00072 
BXCDPF  00073 
BXCDPF  00074 
BXCDPF  00075 
BXCDPF  00076 
BXCDPF  00077 
BXCDPF  00078 
BXCDPF  00079 
BXCDPF  00080 
BXCDPF  00081 
BXCDPF  00082 
BXCDFF  00083 
BXCCFF  00084 
BXCDPF  00085 
BXCDPF  00086 
BXCDFF  00087 
BXCDFF  00088 
BXCDPF  00089 
BXCDPF  00090 
BXCDFF  00091 
BXCDFF  00092 
BXCDPF  00093 
BXCDFF  00094 
BXCDPF  00095 
BXCDFF  00096 
BXCDFF  00097 
BXCDPF  00098 
BXCDFF  00099 
BXCDPF  00100 
BXCDPF  00101 
BXCDPF  00102 
BXCDPF  00103 
BXCDPF  00104 
BXCDPF  00105 
BXCDPF  00106 
BXCDPF  0010T 
BXCDPF  00108 
BXCDPF  001 00 
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rt  A 


160  XREFLE  S  XLEULE-l) 

cat  =  (W.E(1LE)-W<EFLE)  /  (YLE(ILE)  -  YREFLE) 

CO  TO  1*0 

c 

C  OKRD  CENTER  LIES  ON  SEGtnNT  Etc  POINT 

170  CONTINUE 

rEW.OCUEW.QC)  =  (W.E(lLE)-1.0)*XSUBDV  ♦  IXBW 
CO  TO  190 
C 

C  CHORD  CENTER  LIES  WITHIN  THE  SEGMENT 

180  CONTINUE 

rEW.OCUEX.CC>  =  (  XREFLE  ♦  DELE* (Y CHCR D-YR EFLE)  -  1.0  )*XSUBDV 
1  ♦  1WW 

C 

190  CONTINUE 

rEW.ocuEw.oc>  =  in  -<FEW.o:uEw.ocn  ♦  .5 
ISTART  =  FEW.OCUEn.OC)  +  1 
C 

C  THE  ECU- OWING  CODE  FIND?  THE  TRAILING  EDGE  Of  THIS  CHORD  IN 

C  THE  SAME  MAHER  AS  ABOVE. 

2*0  CONTINUE 

IF  (Y CHORD  -  YTE(ITE))  280,270,250 
290  CONTINUE 

YREFTE  =  YTE(ITE) 

ITE  =  ITE  ♦  1 

IF  (ITE  .CT.  NTE)  GO  TO  TED 
IF  (YREFTE  -  VTE(ITE))  260,250,7*0 
260  WIEFTE  =  XTE(ITE-l) 

DELTE  =  (XTE(ITE)-WiEFTE)  /  (YTE( ITE) -YREFTE) 

CO  TO  240 
270  CONTINUE 

TEWOC( JEW.OC)  =  (XTE(ITE)-l  .0)*XSLBDV  ♦  IXBW 
CO  TO  290 
280  CONTI  WJE 

TEW.OC ( JEW.OC)  =  (  WtEFTE  ♦  DELTE* CTCHORD-YREFTE)  -  1.0  )*XSUBDV 

1  ♦  IXBW 

290  CONTINUE 

TEW.OCUEW.OC)  =  IFIX'TEW.OCUEXLOC)>  ♦  .5 
IOC  s  TEW.OC  ( JEW.OC) 

IF  (I EtC  .GY.  LSRR)  GO  TO  770 

SET  BCK  CODES  TO  1  FOR  FLAtFCRM  BOXES  CF  THIS  CHORD 
300  CONTINUE 

CALL  NCCEER  (IB0X,L$R0W6,  ISTART,  JORD,  I  END,  1  ) 

C 

MX8S  =  MAW)  (MXBS, I END) 

JEW.CC  s  JEW.OC+1 
YCHQRD  *  Y CHORD  ♦  DEL 
350  CONTINUE 

C  DC  OF  LOOT  ON  CHORDS 

c 

IF  (WING)  GO  TO  360 
MXBST  *  MW)S 

K*8T  *  (MXBS-t  XBW) /N5U6DV  ♦  t 
NYBST  «  NSC  HR  D 
CO  TC  570 
360  MX3JW  s  NCOS 


BXCDPF  001 II 
**CDPF  00112 
BXCDPF  00113 
BXCDPF  COll* 
BXCDPF  U0115 
BXCDPF  00116 
BXCDPF  00117 
BXCDPF  00118 
BXCDPF  00119 
BXCDPF  00120 
BXCDPF  00121 
BXCDPF  00122 
BXCDPF  00123 
BXCDPF  0012* 
BXCDPF  00125 
BXCDPF  00126 
BXCDPF  00127 
BXCDPF  00128 


BXCDPF  00129 
BXCDPF  00130 
BXCDPF  00131 
BXCDPF  00132 


BXCDPF  00133 


BXCDPF  C013* 
BXCDFF  00135 
BXCDPF  00136 
BXCDPF  00137 
BXCDPF  00138 
BXCDPF  00139 
BXCDPF  00140 
BXCDPF  001*1 
BXCDPF  00142 
BXCDPF  001*3 
BXCDPF  0014* 
BXCDPF  001*5 
BXCDPF  001*6 
BXCDPF  001*7 
BXCDPF  001*8 
BXCDPF  001*9 
BXCDPF  00150 
BXCDPF  00151 


BXCDPF  00152 
BXCDPF  00153 
BXCDPF  0015* 
BXCDPF  00155 
BXCDPF  00156 
BXCDPF  00157 
BXCDPF  00158 
BXCDPF  00139 
BXDPF  00160 
BXCDPF  00161 
BXCDPF  00162 
BXCDPF  00163 
BXCDPF  0016* 


BXCDPF  00165 


BXCDPF  00166 


MX8W  =  (MXBS-I XBW)  /NSUGCV  ♦  1 

BXCDPF 

00167 

MTBSW  =  NSCHRC 

BXCDPF 

00166 

STD  CONTINUE 

BXCDPF 

00169 

IF  (I ERR  0)  CO  TO  750 

BXCDPF 

001 70 

C 

BXCDPF 

00171 

RETURN 

BXCDPF 

00172 

C 

BXCDPF 

00173 

C  ERROR  UMCCftTICS 

BXCDPF 

00174 

C 

BXCDPF 

00175 

C  LIMIT  EXCEEDED 

BXCDPF 

00176 

710  I  ERR  s  1 

BXCDPF 

00177 

EDCE  =  8H  LEADING 

.  BXCDPF 

00178 

I SEC  -  ILE  -  1 

BXCDPF 

00179 

CO  TO  730 

BXCDPF 

00180 

720  I  ERR  =  1 

BXCDPF 

00181 

EDCE  =  8HTRAILING 

BXCDPF 

00182 

I SEX  =  ITE  -  1 

BXCDPF 

00183 

CO  TO  730 

BXCDPF 

00184 

C  BAD  EDCE  DEFINITION 

BXCDPF 

00185 

730  I  ERR  =  2 

b^DPF 

C0186 

EDCE  3  OH  LEADING 

BXCDPF 

00187 

I SEX  3  ILE  -  1 

BXCDPF 

00188 

CO  TO  750 

BXCDPF 

00189 

740  I  ERR  3  Z 

BXCCFF 

00190 

EDGE  =  8H7RAILING 

BXCDPF 

00191 

I SEC  3  1TC  -  1 

BXCDPF 

00192 

C 

BXCCFF 

00193 

730  CONTINUE 

BXCDPF 

00194 

W?ITE(NT6|750O)  SURE.  EDCE 

BXCDPF 

00195 

7300  FCKMAT<22H0***  ERROR  PROCESSING 

,A5,IOHGEOCIRr, 

,A6i  9H  EDGE  ***>  BXCDPF 

00196 

CO  TO  (755. ■'60, 800)  I ERR 

BXCDPF 

00197 

735  WUT£(NT6.7550)  ISEC 

BXCDPF 

00198 

7530  FCKMAT <5X,  8HSECTI0N  ,I2,24H 

IS 

BEYCND  THOSE  DEFINED  )  BXCCFF 

00199 

CO  TO  800 

BXCDPF 

00200 

760  W? I  IE  (NT 6, 7600)  I  SEC 

BXC.'PF 

00201 

7800  FORMAT (5X.  8HSECTI0N  ,I2,3€H 

OF  THE  EDGE  DOUBLES 

BACX  TOHWTD  THE  BXCDPF 

00202 

1  12M  CENTER  LI»E  ) 

BXCCFF 

00203 

CO  TO  800 

BXCDPF 

00204 

C  WUUTCRH  EXCEEDS  BOX  PATTERN  LIMIT 

BXCCFF 

00205 

no  CONTINUE 

BXCDPF 

00206 

ERR  s  3 

BXCDPF 

0C2O7 

EDGE  3  8HTRAILIN1 

BXCCFF 

00208 

ISEC  3  ITE  -  1 

BXCDPF 

00209 

WUTE  (NT6.7700)  ISEC, SURF,  JOKD,  IFK) 

BXCCFF 

CC210 

▼*30  FORMAT  (TCri  i  iv/ii 

1J.29H  O  THE  TRAILING  EDGE  CF  THE  BXCCFF 

90211 

1  A4.14H  CAUSES  OKRD  I5.14H 

TO  GC  TC  ROW  I3.15H,  VHICH  EXCEEDS  BXCDPF 

0021? 

2  1 AH  THE  LIMIT  **4  ) 

BXCDPF 

00213 

I END  3  LSROfc 

BXCDPF 

00214 

c  CO  BACX  TO  FINISH  THE  SURFACE,  C.sEX  PRINT  PLArTCRM  ATC  FLUSH  BXCDPF 

00215 

CO  TO  300 

BXCDPF 

00216 

c 

BXCDPF 

00217 

800  CA  FRNTBCUBOX.LSROWB,  J  XB 

.MXBf  ,  NSCHRD,  .T.) 

BXCDPF 

00218 

C 

BXCDPF 

00219 

8000  CALI  ‘XU5HU) 

BXCDPF 

00220 

C 

BXCCFF 

00221 

ETC 

BXCDPF 

(.0.  .V 

864 


W  N  ►» 


C 

c 

C 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 


c 

c 


c 


SUBROUTINE  BXCDI  UWAKE.LSRCW5.LSCHDS,  IbOX) 

DIMENSION  IWAKEUMBOX(LSROW5,l> 

CCTERMlfCS  BOX  CODES  Fcr  DIAPHRAGM  REGIONS 

iwmr  -  array  OF  WAKE  LIMITS,  AS  DICTATED  BY  A  TAIL  SURFACE 
LSRCV6  -  ROW  DIMENSION  CF  THE  BOX  CODE  ARRAY 
LSCHDS  -  MAXIMUM  NUMBER  OF  BOX  COCES  ALLOWED  PER  RCW 
IBOX  -  BOX  COCE  ARRAY,  COMPRESSED  TO  20  CODES  PER  WCRD 

CO440N  /FILES  /  NT5.NT6, INTAPE, IKFSP,NFLAIC,«PAIC,NaJTP, 

1  IOUFSP.MCCESC.IVPSC.IOECSC.IWTFSC.IAICSC 

COMX  /GECMTY/  COPLAN, NSUBDV, XSL8DV, N5UBC2, NSUBCN.NSLRF, 

B1  , BIBETA, BIS, B1BTAS,  W.AX, VLAZ.  PSIW, 

MX8W,  MXBEW,  Mf  BW,  MYBBW,  MXBSW,  MT  3SW,  MT  BBSW, 

IX8W,  XCENTR 

LOGICAL  COPLAN 

COMMON  /GEOC  /  TLAX.TLAZ ,  FS'  T,  MXBT,Mi'BT,MTBBT,MXt5ST,MfBST, 

»  MYBBST.IXB' .IXBST.CAPL 

CO*«N  /SAMPLW/  ISMPLW,  ICHOR  DUO) ,  IBOXF  <101  ,  IDOL  (10'  ,2LCC  (10) 
COWCN  INPUT  VALUES- 

MX8BSW,  MXBBST.IXBST,  WBSW.MTBST.MTBBSW.MrBBST,  NSUBDV 
ISMPLW 

COMCN  OUTPUT  VALUES- 

WTBBSW,  MC3BST,  MTBBW.MTBBT 
DIMENSION  ICCCEtlBO) 

LOGICAL  WING 

DETERMINE  WETHER  THIS  IS  A  WING  OR  TAIL 
IF  <IWWE(1)  .EQ.  0)  GO  TO  00 
WNG  =  .T. 

IXBS  =  1 
IXSS1  =  2 

MXBBS  =  MXBBWMOUBDV  ♦  IX8W  -  NSUBCN 

IF  (COPLAN)  MXBBS  =  MXBST 

JEXLOC  -  1 

MS' BBS  =  NT  BBSW 

MfBS  -  MTBSU 

CO  TO  ICC 

THIS  IS  A  TAIL  SURFACE 
00  WING  r  . P. 


IXBS  =  IX3ST 
IXBS1  =  IXBS  ♦  1 
MXBBS  =  MXBST 
JE*J_CC  s  MYBSW  ♦  t 
NTBSS  =  NTBBST 
MDBS  s  MYBST 
too  CONTINUE 

MXBBSt  a  MX8BS-1 
C 

C  DETER  MINE  LEADING  EDGE  DIAPHRAGM 

DO  130  4  ■  2.WBS 

CALL  DCCCERdSCW.LSRCWS,  IKBS.A-!,  IXBSI.J-I,  .T.,  IC<S>Ett>  ) 
DO  120  I  3  1  >3641  ,  MXBBSt 

CALL  DCOCESUBOX.LSROMS,  I.J,  l,},  .T.,  JCOO  ) 

ICOCC(t)  =  ICCf:E(2) 

ICCCE  12)  s  IfCCE<3> 


bxcdi 

00002 

BXCDI 

00003 

BXCDI 

00004 

BXCDI 

00003 

BXCDI 

00006 

BXCDI 

00007 

BXCDI 

00000 

BXCDI 

00000 

BXCDI 

00010 

BXCDI 

00011 

FILES 

OOOC2 

FILES 

00003 

GECMTY 

00002 

GECMTY 

00003 

GECMTY 

00004 

GECMTY 

00005 

GECMTY 

00006 

GEOC 

00002 

GEOC 

00003 

SAMPLW 

00002 

BXCDI 

00015 

BXCDI 

00016 

BXCDI 

00017 

BXCDI 

00018 

BXCDI 

00019 

BXCDI 

00020 

BXCDI 

00021 

BXCDI 

00022 

BXCDI 

00023 

BXCDI 

00024 

BXCDI 

00025 

BXCDI 

00026 

BXCDI 

00027 

BXCDI 

00020 

BXCDI 

00029 

BXCDI 

00030 

BXCDI 

00031 

BXCDI 

00032 

BXCDI 

00033 

BXCDI 

000 3 < 

BXCDI 

00035 

BXCDI 

00036 

BXCDI 

00037 

BXCDI 

00038 

BXCDI 

00039 

BXCDI 

00040 

BXCDI 

00041 

BXCDI 

00042 

BXCDI 

00043 

BXCDI 

00044 

BXCDI 

00045 

BXCDI 

00046 

6CSGCB 

000th 

6XC0I 

00048 

BXCDI 

00049 

SXCDI 

COO  50 

BXCDI 

r^05) 

B55 


CALL  DCCOBHIBOX.LSRCVS,  IM.J-1.  Hl.J-l.  .T.,  ICCCE<3>) 

BXCDI 

00052 

IE  (ICCO  0)  OO  TO  120 

BXCDI 

00053 

IF  (ICOOE(I)  .EH.  0  .OR.  ICOCE(J)  .EH.  0)  CO  TO  120 

BXCDI 

000 5A 

CALL  NCQL'ER  (IBOX,  LSRCW5 ,  I ,  J ,  I,  2  ) 

BXCDI 

00055 

120  CONTINUE 

BXCDI 

00056 

130  CONTINUE 

BXCDI 

00057 

c 

EM)  OF  DOUBLE  LOOP  TO  DETERMINE  LEAD  INC  EDOE  DIAPHRAGM  AREAS 

BXCDI 

00058 

c 

BXCDI 

00059 

c 

DETERMINE  TRAILING  EDGE  WAKE)  DIAPHRAGM 

BXCDI 

00060 

* 

II 

o 

BXCDI 

00061 

DO  180  J  =  1 (MTBS 

BXCDI 

00062 

IF  (WINC)  IWC  =  IWAKE(J) 

BXCDI 

00063 

CALL  DCCCER(IBOK,L3RCk£,  IXBS.J,  IXBS.J,  .T.,  ICCO) 

BXCDI 

00064 

DO  1*0  I  s  IKBS1  .MXBBS 

BXCDI 

00065 

iccom  =  iccd 

BXCDI 

00066 

CALL  DC ODER < I BCfc , LSROWS ,  I,J,  I , J .  .T.,  ICCO) 

BXCDI 

00067 

Ir  (ICCO  .EH.  1)  CO  TO  1*D 

BXCDI 

00068 

IF  (tcccm  .NC.  1  .AMD.  ICCCN1  .NE.  3)  CO  TO  170 

BXCDI 

00069 

IF  (I  .LE.  IVK)  CO  TO  160 

BXCDI 

00070 

IF  (I  .EH.  MXBBS)  CO  TO  180 

BXCDI 

00071 

c 

THE  BOX  IS  A  CANE! DATE.  SEARCH  DIAGONALLY  FCR  “CSSIBLE 

BXCDI 

00072 

c 

RECEIVING  BOXES  DO*6TREAM. 

BXCDI 

00073 

Km 

* 

II 

u 

BXCDI 

00074 

JN  =  J 

BXCDI 

00075 

IS  =  1*1 

BXCDI 

00076 

DO  130  II  =  IS.MX3BS 

BXCDI 

00077 

IF  (JN  .CT.  1)  JM  =  JM  -  1 

BXCDI 

00078 

CALL  DCCCEK( I BOX. LSROWS,  II.JM.  II, JM,  .T.,  ICCO  > 

BXCDI 

00079 

IF  (ICCO  .»E.  0)  CO  TO  160 

BXCDI 

00080 

IF  (JP  ,CE.  WBBS)  CO  TO  150 

BXCDI 

00081 

JP  =  JP  ♦  1 

BXCDI 

00082 

CALL  DC  COER  ( 1  oCK ,  LSRCVE ,  II,  JP,  II, JP,  .T.,  ICCO  ) 

BXCDI 

00083 

IF  (ICCO  .NE.  0)  CO  TO  160 

BXCDI 

0008 T 

IF  (.NOT.  WHIG)  GO  TO  150 

BXCDI 

00085 

IF  (  II  .LE.  IWAKEUM)  )  CO  TO  160 

BXCDI 

00086 

IF  (  II  .LE.  IWAKE(JP)  )  GOTOI60 

BXCDI 

00087 

130 

CONTINUE 

BXCDI 

00088 

c 

DC  CF  LOOP  ON  DIAGONAL  SEARCH 

BXCDI 

00069 

CO  TO  170 

BXCDI 

00090 

c 

BXCDI 

00091 

c 

COCITIONS  HAVE  BEEN  FCUM3  FCR  A  VALID  WAKE  BOX 

BXCDI 

00092 

100 

CONTINUE 

BXCDI 

00093 

CALL  NCCCOHIBOK, LSROWS,  I,J,  I,  3  ) 

BXCDI 

00094 

ICCO  =  3 

BXCDI 

00095 

1*0  CONTINUE 

BXCDI 

00096 

c 

DC  CF  LOOP  ON  ROWS.  ANC 

BXCDI 

00097 

i«0 

CONTI  NX 

BXCDI 

00098 

c 

EM)  CF  LOOP  ON  CHORDS,  FCR  WAKE  DIAPHRAGM,  FROM  130* 

BXCDI 

00099 

c 

BXC’TI 

00100 

c 

DETERMINE  THE  TIP  DIAPHRAGM  REGION 

BXCDI 

00101 

USB  *  2 

BXCDI 

00102 

DO  300  I  -  IX85I  .MXBBSl 

BXCDI 

00103 

c 

BEAR  CM  TOR  LAST  NCN-ZERO  BOX  CCCE  ON  THE  ROW,  PROM  LBB  OUTWARD  BXCDI 

00104 

CALI  'bCCOERUBOK.LSRCMS.  I.LBB,  I, WBBS,  ,T.,  ICOCE(LBB)  ) 

BXCDI 

00105 

200 

LBB,  s  LBB*! 

BXCDI 

00106 

DO  Z  )  J  *  LBBPt  iMTBBS 

BXCDI 

00107 

IF  ((COCECJ)  .CO.  0)  CO  TO  220 

BXCDI 

OOtOfl 

B56 


210  CONTINUE 

BXCDI 

00109 

UB  a  Mr  BBS 

BXCDI 

00110 

GO  TO  225 

BXCDI 

00111 

220  LBB  a  J  -  1 

BXCDI 

00112 

c 

LBB  *  TOE  SUBSCRIPT  OF  TOE  LAST  NON-ZERO  BOX  ON  TOE  RCW 

BXCDI 

00113 

c 

TEST  BOM  DIRECTLY  AHEAD  FCR  NON-ZERO  VALUE 

BXCDI 

00114 

225  CONTINUE 

BXCDI 

00115 

CALL  DCCCERCIBOM.LSRCMS,  I-l.LBB,  I-l.LBB,  .T.,  ICOC) 

BXCDI 

00116 

IF  (ICCC  ,E0.  0)  CO  TO  280 

BXCDI 

U011T 

c 

SEARCH  FCR  A  NON-ZERO  C<XE  ON  TOE  IWCARD  DIAGONAL  AFT 

BXCDI 

00118 

J  a  LBB 

BXCDI 

00119 

IP1  s  1  ♦  1 

BXCDI 

00120 

IF  <m  .CT.  MX8BS)  CO  TO  310 

BXCDI 

00121 

DO  230  II  =  IPl.MXBBS 

BXCDI 

00122 

CALL  DC CCER  (IB0X,LSRCV6 ,  II, J,  II, J,  .T.,  1C0D) 

BXCDI 

00123 

IF  (ICCt  .NE.  0)  GO  TO  255 

BXCDI 

00124 

J  »  J  -  1 

BXCDI 

00125 

250  CONTINUE 

BXCDI 

00126 

c 

BXCDI 

00127 

c 

NO  DIAGONAL  BOM  WAS  FOUtC 

BXCDI 

00128 

IF  (tSLftF  .EB.  1  .AM).  ISHFLW  .EB.  0)  CO  TO  310 

BXCDI 

00129 

ir  (.NOT.  WING)  CO  TO  310 

BXCDI 

00130 

c 

SEARCH  BACK  ALONG  TOE  DIAGONAL  FCR  A  DIATORAGH  REGION 

BXCDI 

00131 

c 

CAUSED  BY  A  TAIL  SURFACE 

BXCDI 

00132 

II  a  MXBBS  ♦  1 

BXCDI 

00133 

DO  240  III  a  I PI , MXBBS 

BXCDI 

00134 

II  a  II  -  1 

BXCDI 

00135 

J  a  j  ♦  1 

BXCDI 

00136 

IF  (IWAKE(J)  .CC.  II  )  GO  TO  250 

BXCDI 

00137 

240  CONTINUE 

BXCDI 

00138 

c 

NO  diaphragm  found 

BXCDI 

00139 

CO  TO  310 

BXCDI 

00140 

c 

BXCDI 

00141 

c 

COCITICN  FOUtC  REQUIRING  DUTORAGM  BOXES  ON  TOE  DIAGONAL. 

BXCDI 

00142 

250  JJ  a  J 

BXCDI 

00143 

GO  TO  ZOO 

BXCDI 

00144 

n  JJ  a  J  ♦  1 

BXCDI 

00145 

II  a  II  -  t 

BXCDI 

00146 

2<0  CONTINUE 

BXCDI 

00147 

c 

TEST  FOR  EXCEEDING  BOM  CODE  ARRAY 

BXCDI 

00148 

LBB  a  LBB  ♦  1 

BXCDI 

00149 

IF  (LBB  .CT.  LSCHDS)  GO  TO  8500 

BXCDI 

00150 

c 

SET  DIAGONAL  ELEMENTS 

BXCDI 

00151 

DO  270  J  a  JJ.LBB 

BXCDI 

00152 

CALL  NCCCGR(IBCK,L8RCWS«  II, J,  II,  2  ) 

BXCDI 

00153 

II  a  II  -  1 

BXCDI 

001S4 

270  CONTINUE 

BXCDI 

00155 

I CODE  (LBB)  a  2 

BXCDI 

00156 

MTBBS  a  MAX) (NT BBS, LBB) 

BXCDI 

00157 

CO  TO  200 

BXCDI 

00158 

< 

BXCDI 

00159 

c 

DETERMINE  UST  NON-ZERO  BOM  ON  NEXT  ROW 

BXCDI 

00180 

280  CONTI  MX 

BXCDI 

001  St 

MTBBS  a  HARD (MYIIB, LBB) 

BXCDI 

00162 

II  «  1  ♦  I 

BXCDI 

00163 

DO  290  R  a  I, US 

BXCDI 

00164 

)  *  LBB  -  K  ♦  1 

BXCDI 

00165 

CALL  DCCCERdBOX.LSRCWS,  II, J,  II, J,  .T.,  ICCC)  BXCDI 

IF  (ICCC  .ME.  0)  CO  TO  295  BXCDI 

290  CONTINUE  BXCDI 

CO  TO  300  BXCDI 

295  LBB  =  J  BXCDI 

300  CONTINUE  BXCDI 

C  EtC  CF  LOOP  ON  RONS  DETERMINI  NO  TIP  DIAFHRACM  CODES,  FROM  180*  BXCDI 

C  BXCDI 

310  CONTINUE  BXCDI 

IF  041 NC)  CO  TO  350  BXCDI 

MTBBST  =  NT  BBS  BXCDI 

MTBBT  =  (WBBS*N5UBD2>/N5UBDV  BXCDI 

CO  TO  500  BXCDI 

350  MTBBSM  =  HT BBS  BXCDI 

MTBBW  =  (HfBBS-*-NSUBD2)/N5U8DV  BXCDI 

IF  (.NOT.  COFLAN)  CO  TO  500  BXCDI 

HTBBST  =  NT  BBS W  BXCDI 

MT  BBT  =  MTBBM  BXCDI 

C  BXCDI 

XX)  RETURN  BXCDI 

C  BXCDI 

8500  MUTE  (NT6.9900)  BXCDI 

9500  FOiNAT  (51H0***  ERR®  -  TOO  MANT  CHORDS  FCR  BOX  CCCE  ARRAY  «**  )  BXCDI 

CALL  W»NTBC(IB0X,LSRCV6,IXflS,MXBBS,MrBBS,  .T.  )  BXCDI 

CALL  FLUSH  (1)  BXCDI 

C  BXCDI 

EM)  BXCDI 


00166 
00167 
00168 
00169 
00170 
00171 
00172 
00173 
00174 
001  75 
00176 
00177 
00178 
00179 
00160 
00181 
00182 
00183 
00184 
00185 
00186 
00187 
00188 
00189 
00190 
00191 
00192 
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SUBROUTINE 

CMAREAdBOX, LBXCD.  WING,  ALMA.IJALM,  HALM) 

gmarea 

00002 

gmarea 

00003 

IBC* 

*  ARRAY  OF  BOX  TYPE  COOES 

gmarea 

00004 

LBXCD 

*  ROW  DIMENSION  OF  BOX  CODE  ARRAY 

gmarea 

00005 

WING 

a  PUTFCRM  IACICATCR 

gmarea 

00006 

*•  N(A 

a  ARRAY  OF  ALMAS  (NORMALIZED  AREAS) 

GMAREA 

00007 

IJALPH 

a  SOB  SCRIPTS  FOR  I  BOX  ARRAY  OF  CELLS  THAT  HAVE  ALMAS 

gmarea 

00008 

NOT  EQUAL  TO  0.0  CR  1.0 

gmarea 

00009 

HALM 

=  NUtCER  CF  ALMAS  STORED 

gmarea 

00010 

gmarea 

00011 

CCM4CN  /GECMTY/  CCFLAN,  NSUBDV,  XSUBDV,  N5UBC2 ,  NSUBCN,  NSURF, 

gecmty 

00002 

1 

B1 ,  B1  BETA ,  BIS ,  B1 BTAS ,  ULAX ,  VLAZ ,  PSI W, 

GECMTY 

00003 

2 

MXBW,  MXBBW,  MYBW,  MYBBW,  MXBSW,  HTBSW,  MYBBSW, 

GECMTY 

00004 

3 

IWW.XCENTR 

gecmty 

00005 

LOGICAL  COFLAN 

GECMTY 

00006 

CO4A0N  /CECM2  ✓  TLAX,  TUL2 ,  PSI T ,  MXBT ,  Wf  BT ,  Kf  BBT ,  MXBST ,  Wf  BST , 

GEOC 

00002 

1 

MYBBST ,  I XBT ,  l  »ST ,  CA  FL 

oeoe 

00003 

COMMON  /PLANXY/  NH_E,MrfTE,NTLE,NrrE,  X\*.E(10)  ,YW_E(10> , 

PLANXY 

00002 

1 

XWTE»‘0),YVrE(10>,  XTLE (10)  ,YTLE(!D) , 

planxy 

00003 

2 

XTTT.  10),  YTTE  (10) 

PLANXY 

00004 

COMON  /EDGES  /  Fr*_OCC250) ,  TEXLCC(250) ,  JDIAG 

EDGES 

00002 

gmarea 

00016 

COMON  PARAMETERS  USEE 

gmarea 

00017 

MX8 

=  LENGTH  CF  BCP  PATERN  (X-DIRECTION) 

gmarea 

00018 

MYB 

a  MAXIMUM  ON-FLAffORM  SPAN  (Y-CIRECTION) 

gmarea 

00019 

COfLAN 

=  .T.,  SECOND  SURFACE  EXISTS  FCR  PUTFCRM 

gmarea 

00020 

s  ,F. ,  SINGLE  SURFACE 

GMAREA 

00021 

TfcLE 

=  NUKSER  CF  POINTS  DEFINING  LEADING  EDGE  CF  THE  WING 

GMAREA 

00022 

TWTE 

a  NUMBER  OF  POINTS  DEFINING  TRAILING  EDGE  OF  THE  WING 

GMAREA 

00023 

NILE 

a  NUMBER  CF  POINTS  DEFINING  LEADING  EDGE  OF  THE  TAIL 

GMAREA 

00024 

NTTE 

=  NUMBER  OF  POINTS  DEFINING  TRAILING  EDGE  CF  THE  TAIL 

gmarea 

00025 

XkLE 

a  X  C  OCR  Cl  NATE  CF  THE  LEADING  EDGE  DEFINITION  POINT 

GMAREA 

00026 

FOR  THE  FIRST  fUTFCRM 

gmarea 

00027 

YVLE 

a  Y  COORDINATE  CF  THE  LEADING  EDGE  DEFINITION  POINT 

gmarea 

00028 

FOR  THE  FIRST  FLA  NF CRM 

GMAREA 

00029 

XWTE 

=  X  COORDINATE  OF  THE  TRAILING  EDGE  DEFINITION  POINT 

GMAREA 

00030 

FOR  THE  FIRST  PLATFORM 

GMAREA 

00031 

YWTE 

=  Y  COORDINATE  OF  THE  TRAILING  EDGE  DEFINITION  POINT 

GMAREA 

00032 

FCR  THE  FIRST  PLATFORM 

GMAREA 

00033 

XTLE 

a  X  COORDINATE  OF  THE  LEADING  EDGE  DEFINITION  POINT 

GMAREA 

00034 

FOR  THE  SEC  CM3  FLA  fF  CRM 

GMAREA 

00035 

VTLE 

a  Y  COORDINATE  OF  THE  LEADING  EDGE  DEFINITION  POINT 

gmarea 

00036 

FOR  THE  SEC  CM3  PLATFORM 

gmarea 

00037 

XTTE 

a  X  COORDINATE  CF  THE  TRAILING  EDGE  DEFINITION  POINT 

GMAREA 

00038 

FOR  THE  SECCM)  PLATFORM 

GMAREA 

00039 

YTTE 

a  Y  COORDINATE  CF  THE  TRAILING  EDGE  DEFINITION  POINT 

gmarea 

00040 

FCR  THE  SEC CTC  PLATFORM 

GMAREA 

00041 

GMAREA 

00042 

CO440N  /LAREA  /  LEFT, RIGHT, I CODE 

UREA 

00002 

DIMENSION  IBXI50) 

GMAREA 

00044 

DIMENSION  ALfHA(I),  IJALNIU) 

GMAREA 

00045 

LOGICAL  WING 

GMAREA 

00046 

REAL  LIW, 

LIW,  LINS,  LINA,  LEFT 

GMAREA 

00047 

HALM  a  1 

GMAREA 

00048 

IF  (WING) 

GO  TO  5 

GMAREA 

00049 

MTB  *  MY8T 

gmarea 

00050 

1*8  -  UXST-IX8W>/NSLieCV  ♦  1 

GMAREA 

00051 
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MXB  =  NXBT 

CMAREA 

00052 

ce»€  =  o. 

CMAREA 

00053 

CO  TO  0 

CMAREA 

00054 

5  WS  =  NTBW 

CMAREA 

00055 

IF  (CCSUN)  MYB  =  MAW  (MYB.NYBT) 

CMAREA 

00056 

1X8  =  1 

CMAREA 

00057 

KX8  =  MXBW 

CMAREA 

00058 

IF  (COPUN)  MXB  -  MX8T 

CMAREA 

00059 

8  CONTINUE 

CMAREA 

00060 

c 

CMAREA 

00061 

c 

LOOP  ON  CHORDS 

CMAREA 

00062 

BO  90  J=1  «MTB 

CMAREA 

00063 

YJ  =  J 

CMAREA 

00064 

RIGHT  =  YJ  ♦  0.5 

CMAREA 

00065 

LEFT  =  YJ  -  0.5 

CMAREA 

00066 

IF  {.NOT.  WING)  CO  TO  110 

CMAREA 

00067 

c 

CMAREA 

00068 

c 

CALL  NTRCEP  TO  DETERHI)£  LEFT,  RIGHT  A)©  CENTER  LINE 

CMAREA 

00069 

c 

INTERCEPTS,  Af©  THE  BREAK  POINTS  OF  EDGES  OVER  THIS 

CMAREA 

00070 

c 

OKRD. 

CMAREA 

00071 

c 

CMAREA 

00072 

IF  (YJ  .CT.  YV4_E(NuLE)  >  GO  TO  10 

CMAREA 

00073 

CALL  NTRCEP(J,  YW_E,XW_E,  LINl  ,CEN1  ,RIN1 , 7©K1  ,KI*1 ,  1) 

CMAREA 

00074 

CALL  NTRCEPIJ,  YWTE.XWTE,  LIT©, CEt©,RI)©, f©K2,KIWC2,  2) 

GMAREA 

00075 

10  IF  (NSIKF  .EQ.  1  .OR.  .NOT.  COPUN)  GO  TO  20 

CMAREA 

00076 

c 

COMPUTE  SLOPE  AM)  INTERCEPTS  FCR  SECOND  PUNFCRM. 

GMAREA 

00077 

110  IF  (YJ  .GT.  YTLE(NTLE)  )  GO  TO  20 

CMAREA 

00078 

CALL  NTRCETU,  YTLE, XTLE,  LIN3,CEN3,RIN3,  )©K3,KIM<3,  1) 

CMAREA 

00079 

CALL  NTRCEPIJ,  YTTE,  XTTE,  LIN4,CEN4,RIN*,)©K4,KIN<4,  2) 

CMAREA 

00080 

20  CONTINUE 

CMAREA 

00G81 

c 

SLOPE  AM)  INTERVALS  COMPLETED. 

CMAREA 

00082 

c 

CMAREA 

00083 

c 

LOOP  DOWN  THE  CHORD 

CMAREA 

00084 

CALL  DCCCER ( I BOX , LB XCC ,  IXB.J,  MX8.4,  .F.,  IBX) 

CMAREA 

00085 

II  =  1 

CMAREA 

00086 

00  85  1=1X8, MXB 

CMAREA 

00087 

XI  =  I 

CMAREA 

00088 

IFUBX(II)  .ME.  1)  GO  TO  00 

CMAREA 

00089 

BCXLE  =  XI  -  0.5 

CMAREA 

00090 

BGKTE  =  XI  ♦  0.5 

CMAREA 

00091 

IF{. NOT. WING)  CO  TO  40 

CMAREA 

00092 

IF  (YJ  .GT.  YV4.EOW.E)  )  GO  TO  40 

CMAREA 

00093 

IF  (XI  .GT.  CEM*>  CO  TO  40 

CMAREA 

00094 

c 

BCK  IS  ON  FLAM" CRM  1 

CMAREA 

00095 

ICOCE  =1 

CMAREA 

00096 

c 

I CODE  si,  1ST  L.E.  BOX  CN  CHCRD 

CMAREA 

00097 

c 

=  2,  UST  T.E.  BOX  CN  CHCRD 

CMAREA 

00098 

c 

r  3,  INTERNAL  CUT  BOX 

GMAREA 

00099 

IF(H  .E«.  1)  CO  TO  24 

CMAREA 

00100 

IFdBX(II-l)  .)£.  1)  GO  TO  24 

CMAREA 

00101 

ICOCE  =2 

CMAREA 

00102 

IF  (t.ta.MXB)  CO  TO  24 

CMAREA 

00103 

ir  !(ll*l)  ,NE.  1)  CO  TO  24 

CMAREA 

00104 

IF(  ,1.  .GT.CE)C)  GO  TO  24 

CMAREA 

00105 

ICCC  =3 

CMAREA 

00106 

IU=0 

CMAREA 

00107 

IB=0 

GNAREA 

00108 
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!F<RINJ  .CT.BOXLE)  10=1 
IE(RI»C.LT.BOXTE)  IB=1 
IE<LIFC.LT.B0XTE>  IB=1 
IE  (IU+IB.EB.O)  CO  TO  80 

BOX  IS  NOT  ENTIRELY  ON  PLA^CRM.  COMPUTE  AREA. 

24  CONTINUE 

CALL  ALHiAC (XI ,  XV4.E,YV4.E,XWTF.YWTE, 

lLINl,CENl,RINl,TeKl,Klmi,LITC.Ct>C,RINE,TEK2,KlTK2,ALmA  (NALFH)) 
CO  TO  75 

40  CONTINUE 

IE  U6LRF  .EB.  1)  CO  TO  80 
BOX  IS  ON  FIAAFCRM  2. 

I CODE  =2 

IEd.EB.MXB)  CO  TO  44 
ICCCE  =  1 

IF(XI-1.  .LT.CEN5)  CO  TO  44 
IEdBX(lI-l)  1)  CO  TO  44 

ICCCE  =2 

lE(IBXUlH)  .NE.  1)  CO  70  44 
ICCCE  =3 
IU=0 
1 8=0 

IF(RI».CT.BOXLE)  IU=1 
IE(RIN«.LT.BGXTE>  13=1 
IEU.IN4.LT.B0KTE)  IB=1 
IE  (IUMB.EB.O)  CO  TO  80 

BOX  IS  NOT  ENTIRELY  ON  FLAKFOTM.  CONFUTE  AREA. 

44  CONTINUE 

CALL  ALFHACUI ,  XTLE.YTLE.XTTE.YTTE, 

1LI*B >CEN5iRI WK3 ' KI N(3tLINt,C£N4. RINA,  KCMtKIKKA.  ALMA  (NALFH)  ) 
75  IJALFH(NALFH)  =  J*512  ♦  I 
NALFH  =  NALFH  ♦  1 
80  CONTINUE 
II  =  II  ♦  1 
85  CONTINUE 
90  CONTINUE 

NALFH  a  NALFH  -1 

return 

©e 


CHAREA  00109 
CHAREA  00110 
CHAREA  00111 
CHAREA  00112 
CHAREA  00113 
CHAREA  00114 
CHAREA  00115 
CHAREA  00116 
CHAREA  00117 
CHAREA  00118 
CHAREA  00119 
CHAREA  00120 
CHAREA  00121 
CHAREA  00122 
CHAREA  00123 
CHAREA  00124 
CHAREA  00125 
CHAREA  00126 
CHAREA  00127 
CHAREA  00128 
CHAREA  00129 
CHAREA  00130 
CHAREA  00131 
CHAREA  00132 
CHAREA  00133 
CHAREA  00134 
CHAREA  00135 
CHAREA  00136 
CHAREA  00137 
CHAREA  00138 
CHAREA  00139 
CHAREA  00140 
CHAREA  00141 
CHAREA  00142 
CHAREA  00143 
CHAREA  00144 
CHAREA  00145 
CHAREA  00146 
CHAREA  00147 
CHAREA  00148 
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SUBROUTINE  ALFHAC  CX.XLED.YLED.XTED.YTED, 

ALHUC 

00002 

1 

U  .Cl  «R1 .1CX1  .Kt.L2.C2.R2.  7CIG2  ,K2  .AREA) 

ALFHAC 

00003 

c 

ALFHAC 

00004 

c 

X  a  X  COORDINATE  Cf  CELL  CENTER 

ALFHAC 

00005 

c 

U  =  X  COORDINATE  OF  LEADING  EDGE  LEFT  SIDE  INTERSECTION 

ALFHAC 

00006 

c 

Cl  =  X  COORDINATE  OF  LEADING  EDGE  CENTER  LINE  INTERSECTION  ALFHAC 

00007 

c 

R1  =  X  COORDINATE  CF  LEADING  EDGE  RIGHT  SIDE  INTERSECTION 

ALFHAC 

00008 

c 

K1  =  FLAG  TO  I M) I CATE  LEADING  EDGE  KING 

ALFHAC 

00009 

c 

L2  =  X  COORDINATE  OF  TRAILING  EDGE  LEFT  SIDE  INTERSECTION 

ALFHAC 

00010 

c 

<2  =  X  COORDINATE  CF  TRAILING  EDGE  ENTER  LUC  INTERSECT. 

ALFHAC 

00011 

c 

R2  =  X  COORDINATE  CF  TRAILING  EDGE  RIGHT  SIDE  INTESECTION 

ALFHAC 

00012 

c 

K2  =  FUG  TO  IN! I CATE  TRAILING  EDGE  KING 

ALFHAC 

00013 

c 

AREA  =  AREA  COMPUTED  FOR  THE  CELL 

ALFHAC 

00014 

c 

ALFHAC 

00015 

COMMON  /UREA  /  LEFT, RIGHT, I CODE 

UREA 

00002 

c 

LEFT  =  Y  COORDINATE  OF  LEFT  SIDE  OF  CHORD 

ALFHAC 

00017 

c 

RIGHT  =  Y  COORDINATE  CF  RIGHT  SIDE  OF  CHORD 

ALFHAC 

00018 

c 

ICCCE  =1,  1ST  L.E.  BOX  ON  CHORD 

ALFHAC 

00019 

c 

=  2,  UST  T.E.  BOX  ON  CHORD 

ALFHAC 

00020 

c 

=  3,  INTERNAL  CUT  BOX 

ALFHAC 

00021 

c 

ALFHAC 

00022 

DIMENSION  XC<6),  YC<6) 

ALFHAC 

00023 

DIMENSION  XLEDG1)  .YLED(l),  XTED(l),  YTED(l) 

ALFHAC 

00024 

REAL  LEFT,  LI,  L2 

ALFHAC 

00025 

EPS  =  1.0E-04 

ALFHAC 

00026 

BCKLE  =  X-0.5 

ALFHAC 

00027 

BCKTE  =  X  ♦  0.5 

ALFHAC 

00028 

*J  3  X  -  1.0 

ALFHAC 

00029 

N.  s  X  ♦  1 .0 

ALFHAC 

00030 

AREA  s  0.0 

ALFHAC 

00031 

I SLICE  =  0 

ALFHAC 

00032 

IF  (IC0CE.EB.3)  GO  TO  5000 

ALFHAC 

00033 

IF  (Cl  .GT.XU.AN5.C2.LT  .  )Q_)  GO  TO  3000 

ALFHAC 

00034 

mo 

IFUCCCE.Ea.l)  GO  TO  1000 

ALFHAC 

00035 

1120 

IF<IC0CE.E0.2)  GO  TO  2000 

ALFHAC 

00036 

CO  TO  4000 

ALFHAC 

00037 

c 

ALFHAC 

00038 

c 

LEADING  EDGE  BOX 

ALFHAC 

00039 

1000  CONTINUE 

ALFHAC 

00040 

WRAPS  3  »®K1  ♦  1 

ALFHAC 

00041 

WM1  r  WRAPS  -  1 

ALFHAC 

00042 

NXC  r  WRAPS  ♦  1 

ALFHAC 

00043 

XC<1>  3  U 

ALFHAC 

00044 

YC(1>  =  LEFT 

ALFHAC 

00045 

XC(NXC)  3  Rt 

ALFHAC 

00046 

YC(NXC)  s  RIGHT 

ALFHAC 

00047 

IF  (WRAPS. EQ.l)  CO  TO  110 

ALFHAC 

00048 

DO  100  HA=2, WRAPS 

ALFHAC 

00049 

KIDX  r  Xl+NA-2 

At  PH  AC 

00050 

XC(NA)  3  XLET (KIDX) 

ALFHAC 

00051 

YC (NA)  3  YLED(KIDX) 

ALFHAC 

00052 

too 

coriNue 

ALFHAC 

00053 

110 

CONTINUE 

ALFHAC 

00054 

DO  300  NX  s  1, WRAPS 

ALFHAC 

00055 

IP(XC(NX)  .CE.BOXTE)  CO  TO  300 

ALFHAC 

00056 

A  =  BOKTC  - XC (NX) 

ALFHAC 

0005  7 

CT  =  TC(NX*li  -  YC  (NX) 

ALFHAC 

00058 

lFttY.LT. EPS)  CO  TO  300 

ALPMAC 

00059 

IF(XC(NX*1).CT.B0XTE)  CO  TO  250 

ALPMAC 

00060 

B  a  BOXTE  -  XC(NX*1> 

alpmac 

00061 

200  AREA  a  AREA  ♦  0.5k(A*B>kDY 

AL5MAC 

00062 

CO  TO  300 

ALPHAC 

00063 

C 

ALPMAC 

00064 

C  EDGE  CROSSES  BOXTE.  CCMfVTE  INTERSECTION  FCR  BY 

ALPHAC 

00065 

250  CONTINUE 

ALPHAC 

00066 

B  a  0.0 

ALPMAC 

00067 

CX  =  XC  (NX*  1 )  -  XC  (NX) 

ALPHAC 

00060 

S  =  BY/BX 

ALPHAC 

00069 

BY  a  SKA 

ALPHAC 

00070 

CO  TO  200 

ALPHAC 

00071 

300  CONTINUE 

ALPHAC 

00072 

IF  (BOKTE-BOC.E.LT.EPS)  CO  TO  2000 

ALPHAC 

00073 

IF <R2 .LT . BOXTE)  I SLICE  =Z 

ALPMAC 

00074 

IFCL2.LT.BC*TE?  I SLICE  =1 

ALPMAC 

00075 

IF(ISLICE.)E.O)  CO  TO  5000 

ALPMAC 

00076 

CO  TO  4000 

ALPMAC 

00077 

c 

ALPMAC 

00076 

C  TRAlLlNC  EDGE  BOX 

ALPMAC 

00079 

2000  CONTINUE 

ALPMAC 

oooeo 

WRAPS  =t®K2  ♦  1 

ALPMAC 

00081 

wm  =  WRAPS-  1 

ALPMAC 

00082 

NXC  =  WRAPS*  1 

ALPMAC 

00003 

XC(1)  =  12 

ALPHAC 

00084 

YC(1)=  LEFT 

ALPHAC 

00005 

XC(NXC)=R2 

ALPMAC 

00086 

YC(NXC)=filCHT 

ALPMAC 

00007 

IF(WRAPS.EB.I)  CO  TO  2110 

ALPMAC 

00008 

DO  2100  NA  a  2. WRAPS 

ALPMAC 

00089 

KIDX  =  K2  ♦  NA  -2 

ALPMAC 

00090 

XC(NA)  =  XTEB(KIBX) 

ALPMAC 

00091 

YC(NA)  =  Y  TED  (KIDX) 

ALfMAC 

00092 

21 00  CONTINUE 

ALPMAC 

00093 

2110  CCNTINLF. 

ALPHAC 

00094 

DO  2300  Ntel, WRAPS 

ALfMAC 

00095 

IF(XC (NX)  .LT.BCMLE.AtC . XC (NX*1 )  .LT .B0)Q.E> 

CO  TO  2300 

ALPMAC 

00096 

Dr  a  YC(NX*1)  -  YC(NX) 

ALPHAC 

00097 

IF(DY.LT.EPS)  CO  TO  2300 

ALPMAC 

00098 

IF(XC(NX)  .LT.BOMLE.CR.XC  (NX*1)  .LT.BOitE) 

CO  TO  2250 

ALPMAC 

00099 

c 

ALPMAC 

00100 

C  DOES  NOT  INTERSECT  BOKLE 

ALPMAC 

00101 

A  a  XC(NX)  -  BCMLE 

ALPMAC 

00102 

B  a  XC  < NX*  1 )  -  BOKLE 

ALPHAC 

00103 

2225  AREA  a  AREA  *  0.5k(A*B)KDY 

ALPMAC 

00104 

CO  TO  2300 

ALPHAC 

00105 

C 

ALPMAC 

00106 

C  INTERSECTS  BOKLE 

ALPMAC 

00107 

2250  CONTINUE 

ALPMAC 

00108 

BX  a  XC(NXtl)  -XC  (NX) 

ALPMAC 

00109 

B  a  DY/DX 

ALPMAC 

00110 

A  a  BOKLE  -  XC(NX) 

ALPHAC 

00111 

YIW  a  YC (NX)  *  SKA 

ALPHAC 

00112 

IF(S.Lf  .0.0)  CO  TO  22T5 

ALPHAC 

00113 

C 

ALPHAC 

00114 

C  SLOPE  POSITIVE 

ALPMAC 

00115 

863 


A  =  0 

>  =  XC<NX*1>  -  BOXLE 
W  a  YC<NX*1>  -  VINT 
CO  TO  2225 
C 

C  SLOPE  NATIVE 

2275  CONTINUE 
A  =  -A 
S  =  0 

W  =  TINT  -  YC  (NX) 

CO  TO  2225 
2300  CONTINUE 

1F<R1.LT.B0«LE>  ISUCE  =3 
IF(ISLICE.NE.Q)  CO  TO  5000 
CO  TO  4000 

c 

c  OKRD  HAS  CN.Y  1  BOX 

3000  CONTINUE 
BOKLE  =  fil 
BOtCTE  a  RI 
CO  TO  1000 


‘  -  -  «*  - 

c  IS  CUT  OT.  C<*KCR  <«..L.,L.Ro  CR  U.B.) 

C 

3000  CONTINUE 

IP’lISLICE.fE.O)  GO  TO  5005 
**EA  =  (RIGHT-LEFT) 

3005  CONTINUE 
TA  a  0.0 

IF(ISLICE.B8.3)  CO  TO  5020 
IF(L2.LT.B0*TE)  GO  TO  5100 
*10  IFOJ2.LT.BOOCTE)  CO  TO  5102 
3020  CONTINUE 

!r»^f'“-1-CR-,5l-ICE  Ea  2>  CO  TO  5400 
IF(R1  .CT.B06Q.E)  CO  TO  53 00 
CO  TO  5400 
5100  I  TAG  =  i 
I  =  1 

XCU)  =  12 
red)  a  LEFT 
CO  TO  5110 
5102  ITAC  =  2 
I  =  1 

*U>  a  R2 
rC(l)a  RIGHT 
5110  1=  1*1 

IF<NBK2.Efl.0>  CO  TO  5150 
KIDX  -K2  ♦  I  -  2 

,f(I  i.ta.2)  KICK  a  K2  ♦  HK2-J  -i  *2 

IFOfTtDIKIOXJ.CT.BOXTE)  CO  TO  5125 
*<I>  =  XTCD(KICX) 

TCU)  =  YTED  (XICX) 

CO  TO  5110 
5I?5  CCNTINUE 


ALPHAC 

ALWAC 

alphac 

alphac 

alphac 

alphac 

alphac 

ALPHAC 

alphac 

ALPHAC 

alphac 

alphac 

alphac 

alphac 

alhuc 

alphac 

alphac 

alphac 

alphac 

alphac 

ALPHAC 

alphac 

alphac 

ALPHAC  I 
ALPHAC  I 
ALPHAC  I 
ALPHAC  ( 
ALPHAC  ( 
ALPHAC  ( 
ALPHAC  C 

alphac  c 
alfhac  c 
alphac  0 
alphac  0 
alphac  0 
alfhac  0 
alphac  o 
alphac  a 
ALPHAC  a 

alfhac  a 
alphac  oc 
alphac  a 
alphac  oc 
alphac  oc 
alphac  oc 
alpha c  oc 
alphac  00 
alphac  00 

ALPHAC  00 
ALPHAC  00 
ALPHAC  00 
ALPHAC  00 
ALPHAC  00: 
ALPHAC  00: 

alphac  001 

ALFHAC  001 
ALFHAC  001 


(AC  0011$ 

(ac  ooi it 
(AC  00118 
(AC  00119 
(AC  00120 
IAC  00121 
IAC  00122 
IAC  00123 
AC  00124 
AC  00125 
AC  0012$ 
AC  00127 
PC  00128 
PC  00129 
PC  00130 
PC  00131 
>C  00132 
PC  00133 
ic  00134 
>C  00135 
C  00136 
C  00137 
C  00138 
C  00139 
C  00140 
C  00141 

:  001.12 
:  00143 
:  00144 
:  ooi45 
:  00146 

:  00147 
00148 
00149 
00150 
00151 
00152 
00153 
00154 
00155 
00156 
00157 
00158 
00159 
00160 
00161 
00162 
00163 
00164 
001 65 
00136 
00167 
00168 
00169 
00170 
001  7j 
0017? 
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IFUTA&.Efl.Z)  KICX=KIDX+1 

ALfHAC 

00173 

XCd)  =  BOXTE 

ALPHAC 

00174 

fix  a  XTED(KlDX)  -  XTEDOUDX-1) 

ALWAC 

00175 

BY  a  YTED(XIDX)  -  YTEDIKIDX-1) 

ALfHAC 

00176 

IFdTAG.E8.2>  CO  TO  5130 

ALfHAC 

00177 

C 

ALfHAC 

00178 

C  LOWER  LEFT  CCRNER 

ALfHAC 

00179 

CIST  a  BOXTE  -XCU-l) 

ALfHAC 

00180 

YC Cl)  a  YTED(KIDX-l)  ♦  DIST*(DY/DX) 

ALfHAC 

00181 

CO  TO  5160 

ALfHAC 

00182 

C 

ALPHAC 

00183 

C  LOWER  RIOtT  CORNER 

ALfHAC 

00184 

5130  DIST  a  BOXTE  -  XCd-1) 

ALfHAC 

00185 

YCd)  a  YCd-t>*  DIST*  dJY/DX) 

ALfHAC 

00186 

CO  TO  5160 

ALfHAC 

00187 

5150  CONTINUE 

ALfHAC 

00188 

RC(I)  =  BOXTE 

ALfHAC 

00189 

BX  a  R2  -  L2 

ALfHAC 

00190 

DY  a  RIGHT  -  LEFT 

ALfHAC 

00191 

IFUTAC.EB.2)  CO  TO  5155 

ALfHAC 

00192 

DIST  a  BOXTE  -L2 

ALfHAC 

00193 

YCd)  =  LEFT  ♦  CIST*<DY/DX) 

ALfHAC 

00194 

CO  TO  5160 

ALPHAC 

00195 

5155  DIST  a  BOXTE  -R2 

ALfHAC 

00196 

YCd)  a  RIGHT*  DIST*(DY/DX) 

ALPHAC 

00197 

5160  CONTINUE 

ALfHAC 

00198 

WRAPS  a  1-1 

AUHAC 

00199 

DO  5175  NX=1,NTRAPS 

ALfHAC 

00200 

A=  BOXTE  -  RC(NX) 

ALfHAC 

00201 

It  BCXTE  -  XCINX+l) 

ALfHAC 

00202 

IFU.6T.1.)  A  a  1.0 

ALfHAC 

00203 

IFTB.CT.l.)  B  =  1.0 

ALfHAC 

00204 

Hr  YCINX+1)  -  YC(NX) 

ALfHAC 

00205 

IFtITAC.EB.2)  H  a  -H 

ALPHAC 

00206 

TA  a  TA  ♦  0.5*(A+B)«H 

ALfHAC 

00207 

51?5  CONTINUE 

ALfHAC 

00208 

IF(ITAC.EB.Z)  CO  TO  5020 

ALFHAC 

00209 

CO  TO  5013 

ALfHAC 

00210 

C 

ALfHAC 

00211 

C  COMPUTE  FCR  UPPER  RIOTT  HAND  CORNER 

ALfHAC 

00212 

5300  CONTINUE 

ALfHAC 

00213 

I  a  1 

ALfHAC 

00214 

XCd)  a  ft! 

ALPHAC 

00215 

YCd)  a  RIGHT 

ALfHAC 

00216 

5310  I  *  !♦» 

ALfHAC 

00217 

iFUCKl.Ea.O)  CO  TO  5350 

ALWAC 

00218 

RIDX  a  K1  *  W(t*l  -I  *2 

ALfHAC 

C0219 

IFOtCD'JUDX)  ,LT .BC0Q.E)  CO  TO  5325 

ALfHAC 

00220 

XCd)  a  *.Efi<KIDX> 

ALfHAC 

00221 

YCd)  a  VLESOdfiX) 

ALfHAC 

00222 

CO  TO  5310 

ALfHAC 

00223 

5325  CONTINUE 

ALPHAC 

00224 

xcd)  «  boxlc 

ALPHAC 

00225 

OX  s  *.ED<XIDX*1)-)0.ED«U0X> 

ALPHAC 

00226 

BY  «  YLED<KIDX»1)-YLEDIKI0X) 

ALfHAC 

00227 

BIST  *  80XLC  -  XLCD(XIDX) 

ALPHAC 

00228 

YCdlr  YLCC <KI CX)  ♦  DIST*<CY/DX) 

ALfHAC 

00229 

B65 


•'-J ■  •  *-•  S!i2£! 


L _ .HA.^ 


2tf£zca=*5 afc 


GO  TO  5360 
S3 90  CONTINUE 

»CCI>  *  IQKLE 
DX  «  Rt  -LI 

err  *  ri«t  -  left 

BIST  *  BOS.E  -  Li 
VC(I>=  LEFT  ♦  DIST*(DY/DX) 

5360  CONTINUE 

NTRAPS  =  I-i 
DO  5373  NX  =  1, NTRAPS 
A  *  XC(NX)  -  8CW.E 
B  *  XC(NX4l)-BOXLE 
IFtA.LT.l .  .AMJ.B.LT.i  . )  GO  TO  5370 
JF(A.GT.1..AM).B.GT.1.>  GO  TO  5365 
C 

C  A.CT.B1  AND  B.LT.B1 

DX  =  XC(NX)  -  XC (NX+1 ) 

DT  =  VC  (NX)  -  VC  (NX-f  1 ) 
IF(DV.LT.EPS)  GO  TO  5375 
DIST  =  BOKTE  -  XC(NX*1) 

VINT  =  YC(NX*1>  ♦  DIST*(W/DX) 

TA  =  <YC<NX)-YINT)  ♦TA 
VC  (NX)  =VINT 
A  =  1.0 
CO  TO  5370 
5365  CONTI  HJE 

TA  =  TA  ♦  (VC  (NX)  -VC  (NX*T ) ) 

CO  TO  5375 
5370  CONTINUE 

H  =  VC(NX)  -  YC(NXM) 

TA  =  TA  ♦  0.5*(A+B)  <H 
5375  CONTINUE 
5400  AREA  =  AREA  -TA 
4000  CONTINUE 
RETURN 
DC 


ALFHAC 

00230 

ALFHAC 

00231 

ALFHAC 

00232 

ALFHAC 

00233 

ALFHAC 

00234 

ALFHAC 

00235 

ALFHAC 

00236 

ALFHAC 

00237 

ALFHAC 

00238 

ALFHAC 

00239 

ALFHAC 

00240 

ALFHAC 

00241 

ALFHAC 

00242 

ALFHAC 

00243 

ALFHAC 

00244 

ALFHAC 

00245 

ALFHAC 

00246 

ALFHAC 

00247 

ALFHAC 

00248 

ALFHAC 

00249 

ALFHAC 

00250 

AUHAC 

00251 

ALFHAC 

00252 

ALFHAC 

00253 

ALFHAC 

00254 

ALFHAC 

00255 

ALFHAC 

00256 

ALFHAC 

00257 

ALFHAC 

00258 

ALFHAC 

00259 

ALFHAC 

00260 

ALFHAC 

00261 

ALFHAC 

00262 

ALFHAC 

00263 

ALFHAC 

00264 

ALFHAC 

0C265 

A  A  O  A  A  A 


susrc»jtifc  ntrcepij,  yeog.xedg, 


Ll.Cl.Rt.FeKl.Kl.IDEX) 


j  x  ifcex  of  chord  Nuteo; 

FCKl  z  MJFCER  OF  WEAK  POINTS  ON  EDGE  FOR  THIS  CHORD. 

LI  z  X  COORDINATE  CF  LEADING  EDGE  LEFT  SICE  INTERSECTION 

Cl  =  X  COORDINATE  CF  LEADING  EDGE  CENTER  LIFE  INTERSECTION 

M  z  X  COORDINATE  Of  LEADING  EDGE  RIGHT  SIDE  INTERSECTION 

K1  =  IFCEX  CF  XLEA  AFC  YLEA  ARRAYS  THAT  CEFJFE  A  KING  IF 
ONE  EXISTS 

COWON  /LAREA  /  LEFT  .RIGHT,  I  CODE 
REAL  LEFT, LI, L2 

LEFT  =  V  COORDINATE  OF  LEFT  SIDE  OF  CHORD 
RIGHT  =  Y  COORDINATE  OF  RIGHT  SICE  OF  CHORD 
Dl PENSION  XEDG(l),  YEDG(l) 

YJ  =  J 

EPS  =  1 .0E-04 
K=2 

1  tFft.eFT.LT ,YEDG<K)-EPS)  GO  TO  2 
K=  K+l 
GO  TO  1 

Z  DX  =  XECCOO  -XEDG(K-l) 

DY  =  YEEGfK)  -  YEDGlK-1) 

DIST  =  LEFT  -  YEDG(K-l) 
a  =  «DG«-1)  ♦  (DX/DY)  *  DIST 

Fife  OEM  AFC  BEGIN  COUNTING  BREAKS 

F6K1  =  a 

K1  =  0 

3  IFC  YJ  .LT.YEDG(K)  PEPS)  GO  TO  4 

KINKS)  BETVEEN  LEFT  AFC  CENTER  LIFE 
1FCK1 . EB.O)  K1  =K 
F6K1  =  FCKl  ♦  1 
K  z  K  ♦  1 
CO  TO  3 

4  IF(IDEX.Ea.l)  GO  TO  40 
IFCABSCYEDGOO-YJ)  .GT.EPS)  GO  TO  40 
iFoa.Ea.O)  mu 

FOCI  S  FCK1  ♦! 

IF  (YEDGOKD-YEDGCK)  .GT.EPS)  GO  TO  104 
FCK1  s  FCK1  ♦  1 
HUM 
104  CONTI  FEE 

a  Z  XEDGOO 
60  TO  5 

40  DX  z  XtCGtK)  -  XEDGtK-l) 

DY  z  VEDGCK)  -  YEDGIK-I) 

DIST  z  YJ  -  Y£DG<K-1> 
a  Z  XEDGCK-1)  ♦  IDX/DY)  *  DIST 

FIND  41  IN  SAME  MAFtCR  AS  CEN1 
1  ir(RICMT.LT.YEOG(K)FCPS)  CO  VO  S 

KINGS  imCEN  CENTER  LIFE  AFC  RIGHT  SIDE  OF  CHORD 
IFiKJ.Cfl.O)  MU 
FCKl  *  FCKl  ♦  t 
K  =  K  ♦  1 


NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

LAREA 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

FftRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

FORCE. 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NTRCEP 

NYRCEP 

FORCE? 


00002 

00003 

00004 

00005 

00006 

00007 

00008 

00009 

00010 

00002 

00012 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

00023 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 

00036 

00037 

00038 

00039 

00040 

00041 

00042 

00043 

00044 

00045 

00046 

00047 

00048 

00049 

00050 

0)051 

00052 

00053 

00054 

00055 

00056 

00057 

00058 


CO  TO  5 

NTRCEP 

00059 

DX  =  XECCOO  -  XteCO'-t) 

NTRCEP 

00060 

W  =  YEECOO  -  Y€3v<K-l) 

NTRCEP 

00061 

CIST  =  RICHT  -  YeC(K-i) 

NTRCEP 

00062 

ri  —  xedo<k-h  +  <c x/vn  *  civ.r 

NTRCEP 

00063 

RET’XRN 

NTRCEP 

00064 

EH5 

NTRCEP 

00065 

B68 


SUBROUTINE  PWWAIC  <WING,IB0X,L80X,IWAKE,  JCCU 

PWWAIC 

00002 

c 

PWWAIC 

00003 

c 

COMPUTES  THE  POINTER  ARRAY  IMUAIO  FOR  THE  SPATIAL  AIC  ARRAY 

PWWAIC 

00004 

c 

CF  THE  LEFT  WING  (TAIL)  ON  ONE  CHORD  0 F  THE  RICHT  WING  (TAIL) 

PWWAIC 

00005 

c 

PWWAIC 

00006 

c 

WING  =  WING/TAIL  INDICATOR 

PWWAIC 

00007 

c 

I  BOX  =  BOX  CODE  ARRAY  TO  USE 

PWWAIC 

00008 

c 

I WIRE  =  ARRAY  OF  WAKE  EDGE  LOCATIONS  FOR  WING 

PWWAIC 

00009 

c 

JCCL  =  THE  <06 UBDI VICED)  CHORD  NUACER  OF  INTEREST 

(WWAIC 

00010 

c 

SURF  =  INDICATOR  CF  WETHER  ANf  LEFT  SURFACE  IS  INTER¬ 

PWWAIC 

00011 

c 

CEPTED  BY  THE  AMCH  COE  FOR  THIS  CORD 

PWWAIC 

00012 

c 

PWWAIC 

00013 

COPtCN  /GECMYY/  CC#LAN,NSUBDV,XSUBDV,NSUBt2,N5UBCN,M5URF, 

GECMTY 

00002 

t  B1.B1BETA, BIS, BIBTAS.WJAX.VUZ, PSIW, 

GECKTY 

00003 

2  HXBWa  MXBBW,  HTBWi  HTBBWi  MXBSW,  HTBSW,  MTBBSW, 

GECMTY 

00004 

3  I XBW,  XCENTR 

CC04TY 

00005 

LOGICAL  COPUN 

GECMTY 

00006 

COWON /CEOC  /  TUXiTUZi  PSITtM)fflTiMTBT  iMTBBT.HXBST ,WfBST > 

GEOC 

00002 

1  mtbbst.ixbt.ixbst.cafl 

CECtC 

00003 

COWON  /MUAICS/  YBAR,EL,MUAIC(2,S0)  .NROWS.SURF, 

HUAI CS 

00002 

1  YBARL.ELL,  HJAla(2,50)  ,NR0k6L,SlRFL»PSIDIF 

MUAICS 

00003 

LOGICAL  SURF, SLR  EL 

MUAICS 

00004 

OCWON  /EDGES  /  FTXL0CC2SG, ;  TE».0C(250) ,  JDIAG 

EDGES 

00002 

c 

PWWAIC 

00018 

LOGICAL  WING 

PWWAIC 

00019 

DIACNSICN  I  BOX  (LB  OX,  8) ,  ICCCE(50)  ,  IWAKE(l) 

PWWAIC 

00020 

DATA  EPS  /  1  .OE-4  / 

PWWAIC 

0002* 

c 

PWWAIC 

00022 

IF  (WING)  CO  TO  100 

PWWAIC 

00023 

c 

PWWAIC 

□0024 

c 

THE  CALL  IS  FCR  A  TAIL  CHORD 

PWWAIC 

00025 

PSI2  a  PSIT  ♦  PSIT 

PWWAIC 

00026 

1X8  =  (iXBT-IXSW)/NSUBCV  ♦  1 

(WWAIC 

00027 

KXB  =  MX8T 

PWWAIC 

00028 

IF  (JCCL  -LE.  HTBT)  GO  TO  120 

PWWAIC 

00029 

c 

THE  CHORD  IS  ON  THE  TIP  DIAFWAGM 

PWWAIC 

00030 

IFRST  =  1X8 

PWWAIC 

00031 

Mi  s  KXBT-IFR$m 

PWWAIC 

00032 

GO  TO  130 

PWWAIC 

00033 

c 

PWWAIC 

00034 

c 

THE  CALL  IS  FCR  A  WING  OKRD 

PWWAIC 

00035 

100  CONTINUE 

PWWAIC 

00036 

PBI2  s  PSIW  ♦  PSIW 

PWWAIC 

00037 

I)®  s  1 

PWWAIC 

(WT1C 

UAAJUW 

IF  (COPUN)  CO  TO  110 

PWWAIC 

00039 

tf®  s  MX8BW 

PVWAIC 

00040 

IF  (JCCL  .CT.  MTBW)  CO  TO  113 

PWWAIC 

00041 

I  sue  3  jcawsueDv  -  nsubdz 

PWWAIC 

00042 

CO  TO  123 

PWWAIC 

00043 

c 

PWWAIC 

00044 

c 

THE  CALL  IS  FCR  A  COPUNAR  WING- TAIL 

PWWAIC 

00045 

110  CONTINJC 

PWWAIC 

00046 

HX8  3  MX8T 

PWWAIC 

00047 

IF  (JCa  .LE.  MW)  CO  TO  120 

PWWAIC 

00048 

c 

THE  CHORD  IS  ON  THE  TIP  DIAPHRAGM 

PWWAIC 

00049 

113  CONTINUE 

PWWAIC 

00050 

10,51  =  1 

PWWAIC 

OOOM 

ft  A 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 


Hi  « 

PVMAIC 

00052 

CO  TO  190 

PVMAIC 

PVMAIC 

00053 

00054 

THE  CHCRD  IS  ON  PUA^CRM 

PVMAIC 

00055 

120  CONTINUE 

HMAIC 

00056 

I SOB  =  MYBSW  ♦  JCCL*NSUet>V  -  NSUBD2 

PVMAIC 

00057 

125  CONTINUE 

PVMAIC 

00058 

ifrst  »  (Tts_cc<isue>-ixDw)  /  nsubdv  +  i 

PVA4AIC 

00059 

Hi  2  MXB  -  IFRST  ♦  1 

FV.4AIC 

PVMAIC 

00060 

00061 

130  CONTINUE 

PVMAIC 

00062 

CAU.  DCCCEK  (IBOK'LBOK,  IFRST ,  JCCL.  MW.JCCL,  .F. ,  ICCCE) 

fVMAIC 

00063 

IRON  2  IFRS? 

PJMAIC 

00064 

DO  135  I  2  l.HJ 

PVMAIC 

00065 

IA  2  I 

PVMAIC 

00066 

IF  (ICCDE(I)  .NE.  0)  CO  TO  140 

TVMAIC 

00067 

IRON  r  IRON  ♦  1 

PUNA  I C 

□0068 

135  CONTINUE 

N*Me 

00069 

140  CONTINUE 

PvivMC 

00070 

IF  (IA  .CE.  NJ)  CO  TO  155 

PVMAIC 

00071 

DO  143  I  2  IA  i  NJ 

PUNA  I C 

00072 

IF  (ICCCE (I )  .EB.  0)  CO  TO  150 

pvmaic 

00073 

IRON  2  IRON  +  1 

PVMAIC 

00074 

145  CONTINUE 

PVMAIC 

00075 

1*3  CONTINUE 

PVMAIC 

00076 

IRON  2  IRON  -  1 

PVMAIC 

00077 

153  CONTINUE 

PVMAIC 

00078 

WCUG  2  IRON  -1X8+1 

PVMAIC 

PVMAIC 

00079 

00080 

COtfVTE  HORIZONTAL  AND  VERUCAL  OFFSETS 

FVMAIC 

00081 

YMUKtC  2  (JCa-.5)*C06(PSl2) 

PVMAIC 

00082 

2  Y-CFFSET  ON  THE  SEMJING  SURFACE  OF  THE  PROJECTION  OF  THE 

PVMAIC 

00083 

RECEIVING  CHORD 

PVUVIC 

00084 

JBAR  2  IFIXIYMUSN!)  ♦  1 

PVMAIC 

00085 

2  CHORD  CONTAINING  YHJSN! 

PVMAIC 

00086 

YEAR  2  YMUSN!  -  JBAR  ♦  .5 

PVMAIC 

00087 

2  DISTANCE  FROM  NEAREST  SENDING  CHORD  CEWTER  TO  PROJEC¬ 

FVMAIC 

00088 

TION  OF  THE  RECEIVING  CHORD,  POSITIVE  RIO+T. 

PVMAIC 

00089 

EL  =  (JCa  -  .5)  *  SIN(PSI2) 

PVMAIC 

00090 

r  VERTICAL  SEPARATION  BETWEEN  THE  SENDING  PLA?C  AN!  THE 

FVMWC 

00091 

RECEIVING  CHORD 

PVMAIC 

00092 

IF  (YBAR)  160.165,170 

PVMAIC 

00093 

180  JMIN  2  JBAR  -  1 

PVMAIC 

00094 

NOKES  =  2 

PVMAIC 

00095 

CO  TO  ISO 

PVMAIC 

00096 

163  JMIN  r  jBfR 

PVMAIC 

00097 

NJOKE5  =  1 

PVMAIC 

00098 

CO  TO  180 

PVMAIC 

00099 

170  JMIN  2  <2AR 

PVMAIC 

00100 

WCKES  2  2 

PVMAIC 

PVMAIC 

00101 

00102 

180  CONTPAJE 

PVMAIC 

00103 

A  =  1 

PMAIC 

00104 

8URF  :  ,F. 

PVMAIC 

PVMAIC 

00105 

00106 

START  of  loop  ON  ROMS,  FORWARD  FROM  RECEIVING  BOX  CENTER,  TO 

PVMAIC 

0010’’ 

CEFIfC  THC  MUAIC  ARRAY 

PVMAIC 

00  ion 

A  A 


DO  280  I  *  l.mCM  PUAIC 

ABSIEL)  PUAIC 

if  .lc.  eas)  co  to  zeo  puaic 

IF  (JHIN  .CT.  0)  CO  TO  zeo  PUAIC 

CENTER  LINE  HAS  BEEN  CROSSED ■  THEREFORE  THERE  HAT  BE  CONTRIBU-  PUAIC 

TICN  FROM  THE  LEFT  MNG  FCR  THIS  ROM  PUAIC 

JN  *  -JHIN  ♦  t  PUAIC 

JW  «  JH-JL+1  PUAIC 

CALL  DC<XER(IBOK,LBOK,  IRCW.l,  IROH.JI**,  .F.,  ICCCE)  PUAIC 

DO  ZAO  J  -  JL.JM  PUAIC 

IF  (ICODCtJMO  .NE.  0)  CO  TO  Z SO  PUAIC 

JM4  =  JHM-1  PUAIC 

ZAO  CONTINUE  PUAIC 

♦ROWS  =1-1  PUAIC 

CO  TO  Z90  PUAIC 

C  CONTRIBUTINC  BOXES  HATE  BEEN  FOLfrC  FCR  THIS  RCW  PUAIC 

ZSO  CONTINUE  PUAIC 

SURF  =  .T.  PUAIC 

JL  =  J  PUAIC 

IF  (VBAR  .CE.  0)  CO  TO  ZSS  PUAIC 

HMIC(l.I)  s  WOMES  -  JM  ♦  1  PUAIC 

NJAIC(2,n  =  POORES  -  JL*1  PUAIC 

CO  TO  Z*0  PUAIC 

ZSS  CONTINUE  PUAIC 

MUAIC(t.I)  =  JL  PUAIC 

MJAICCZ.I)  =  JH  PUAIC 

GO  TO  ZTQ  FUAIC 

C  PUAIC 

C  CENTER  LINE  HAS  NOT  BEEN  CROSSED  FUAIC 

Z«0  MMIC(t.I)  s  0  PUAIC 

MIMIC  (2 , 1 )  =  0  PUAIC 

C  PUAIC 

ZTO  CONTINUE  PUAIC 

►ACRES  s  ►ACRES  ♦  2  PUAIC 

JHIN  =  JHIN  -  1  PUAIC 

IRON  =  IRON  -  I  PUAIC 

an  CONTINUE  PUAIC 

C  EM)  OF  LOOP  FCRVARD  ON  ROM,  FROM  180*  PUAIC 

C  PUAIC 

290  CONTINUE  PUAIC 

RETURN  PUAIC 

EM)  PUAIC 


00109 
00110 
oom 
001 1.2 
00113 
00114 
00115 

ooue 
0011* 
00118 
00119 
00120 
001Z1 
00122 
00123 
00124 
00125 
00126 
0012* 
00128 
00129 
00130 
00131 
00132 
ail  33 
00134 
00135 
00136 
00137 
00138 
00139 
00140 
00141 
00142 
00143 
00144 
00145 
00146 
0014* 
00148 
00149 
00150 


B71 


OVERLAY  (AFMBQX'1  ,3) 

BOCRAM  MOOES 

COMMON  /PRCBOV  YMACH,  N4CCES , NTSLCP,  MCVALS.  SMOOTH,  fCtC-CRDFI T , 

1  EXAIC,SUBDV,*.YUOCC 

LOCI  CAL  SMOOTH,  CRDFIT.EXAIC.SUBDV,  PLYROOO 

COMMON  /CONTRL/  BEVEX.CMACH,  TITLE (6)  ,  FRVGE04,  FR  VMCCE,  DIHW.DIHT, 
1  DEFAULT 

LOCI  CAL  PR  VCECM,  PR  VMCCE  >  CIHW,  CIHT «  DEFAULT 

CCW40N  /CEOKTY/  COPLAN, NSUBDV,XSUBDV,NSUBB2,NSUBCN,«tJRF, 

1  B1.B18ETA,81S,B1BTAS,VLAX,VLAZ,F5IW, 

2  MXBW,  MXBBW,  MTBW,  MYBBW,  MXBSW,  MYBSW,  MYBBSW, 

5  IWW.XCENTR 

LOGICAL  COPUN 

COMMON  /CECM2  /  TUX.TUZ.PSIT.MXBT.WBT.NCBBT.MXBST.JfBST. 

1  MfBBST ,  I X8T ,  IXBST  ,CAPL 

CCMCN  /FILES  /  NT5,Nr6, INTAPE, IFfSP.NPUIC.NSPAlC.NOUTP, 

1  IOUFSP,MCOESC, I VPSC,I&EC6C, IWTFSC, IAICSC 

fiBUl VALENCE  (IWTFSC,  ITSLSC) 

00*04  /IOC CUT/  0PUIC,C6FAIC,WTG£CM,WT«^F,WrSL,WrBL,PRB0X, 

1  HIRAIC,  FRSAIC,  PRMCCS,  PRCCEF,  FREW,  FRSW,  HI  VP, 

2  FRBL,  BDCP,  PRGNAF,FRGNAC,  PRSL,  FRLW,  PRNW,  PRCM 
BUI  VALENCE  (PRIM  FREW) 

LOGICAL  OPUIC,CBPAIC,WrOECM1WT&mF,WTSL,WrBL,PRBOX,FR~ATC, 

1  WSAIC,  FRMCCS ,  PRCCEF,  FRCW,  FRSW,  FR  VP,  FRBL,  PRSL,  FRCNAF, 

2  FRDCP.FRGWC.FRUW.FRLW.PRNW.FRCM 

CCMCN  /TAPEICy  FFS,FMS,LS,F*R,ID(20)  .NID.ITYFE.LRS.LWB.M,*), 

1  PARM(IO) ,  IRfi 

DIMENSION  IPARM(IO) 

BUI  VALENCE  (FARM.IFARM) 

CCFWQN  /ARRAYS/  KBXCDW.LBXCEW.LBOXC.KBXCDT.LBXCCT.KJALFH.LJALW, 

1  KALFHA,KKERN.,LKEJiH.,KPNrRM,LPNTRM„vCEFSL,KELFHI, 

2  LMaCES,KPNrSD,LPNrSD,KSCW,LSCW,KPNTEW,LFNTDW, 

3  KCW.LCW.KTVP.LTVP 
CCMCN  /  MODES/  SYM.SYMT.MTYPEW.MTYPET 

CCMCN  /CHECK PR/  CFPCPR ,  GEOCPR.MCOCPR.AICCFR  ,f«SCFR  .SMCPR ,  GAFCFR 
LOGICAL  DPPCPR,  GEOCFR,  MOOCPR,  AlCCFR.FfcBCFR,  SMCB,  GAFCFR 
BUI  VALENCE  ( CHECK  FR.MCCCFR) 

LOGICAL  CHECK  FR 

DCF3L<2,fCCKE5) ,  XX(NPTS),  YY,Z2  SAME,  A(NO  CF  CCEF) 
DIMENSION  DEFSL (2. 1000),  XX(IOO)  ,YY (100)  ,2Z<100> ,  A(21> 

C0MO4  /INDEX/  IS(100),NOCUOO>,JS(100>,JOC(100> 

DIMENSION  IFNTRM(2,100) 

DIMENSION  XP(6)  ,YP<6)  ,X1  (100)  ,V1  (100) 

DIMENSION  006(50) 

DIMENSION  FEXL0C(250>,  TEW-OC  (250) 

FE)LOC  (KYBSWfMYBST)  ,  TEXLOC  SAME  ) 

LOGICAL  M)READ,RAFCIN,MXW!IT,RAFCOU 
Nt  MEL  I  ST  /CAR  CM  /  MCCES,  NrSI.OP 
►OREAD  :  .FALSE. 

KXV4RIT  =  .FALSE. 

RAFT  IN  =  .FALSE. 

RA-COU  =  .FALSE. 

CPs  *  1.0E-04 
CAMU  s  1.4 

CAMC  *  XMACH*(CAMHAM  .0)/2. 

IF  (.MOT.  PR  VMCCE)  CO  TO  100 


MCCES 

MOOES 

PRCBLM 

PRCBLM 

PRCBLM 

CONTRL 

CONTRL 

CONTRL 

GECMTY 

GECMTY 

GECMTY 

CCCMTY 

GECMTY 

CEOC 

CEOC 

FILES 

files 

MCCES 

IOCCNT 

IOCCNT 

BCSFRB 

IOCCNT 

IOCCNT 

IOCCNT 

BCSFRB 

TAFEIO 

TAPEIO 

TAPEIO 

TAPEIO 

ARRAYS 

ARRAYS 

ARRAYS 

ARRAYS 

MODCCM 

CHECK  FR 

CHECK  PR 

MCCES 

MOOES 

MCCES 

MCCES 

MCCES 

MOOES 

MOOES 

MOCET 

MCCES 

MOOES 

MCCES 

MOOES 

FTNX1 

MOOES 

MOOES 

MOTES 

MOOFS 

MCCES 

MCCES 

MCCES 

NOTES 


00002 

00003 

P0002 

00003 

00004 

00002 

00003 

00004 

00002 

00003 

□0004 

00005 

00006 

00002 

00003 

00002 

00003 

00009 

00002 

00003 

00001 

00005 

00006 

00007 

00002 

00002 

00003 

00004 

00005 

00002 

00003 

00004 

00005 

00002 

00002 

00003 

00015 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

Er023 

00024 

00026 

00027 

00043 

0002? 

00029 

00030 

00031 

00032 

0)033 

00034 

CQ035 
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n  n  fl  n  n  a  n 


IM.NOT.mvteCM)  CO  TO  50 

MODES 

00036 

wire  <nt«,too5> 

MOOES 

00037 

RETURN 

MOOES 

00038 

MOOES 

00039 

90  CONTINUE 

MODES 

00040 

!F(MTYPEW.E9.3)  CO  TO  T9 

MOOES 

00041 

I F  (NSURP.  Ea  .2 .  AND .  MTY  PET .  E8 . 3 ) 

CO  TO  79 

MOOES 

00042 

WIITE  <NT6,T0l0) 

MOOES 

00043 

CO  TO  125 

MODES 

00044 

MOOES 

00043 

T5  CONTINUE 

MOOES 

0004E 

VSIfE  (NT6.T015) 

MODES 

00047 

CALL  FLUSH  (1) 

MOOES 

00048 

MODES 

00049 

100  CONTINUE 

MOOES 

00030 

MODES 

00051 

MODES 

00052 

FMCDCS  =  0 

MODES 

00053 

NTSLOP  =  0 

MODES 

00054 

READ  (NTS, CANON) 

MOOES 

00055 

123  CONTINUE 

MOOES 

00056 

REVflfC  ICEOKC 

MODES 

00057 

MODES 

ooo  se 

READ  FPO.OC  AH)  TPR.OC  ARRAY  FROM  GEOMETRY  SCRATCH  FILE 

MCCES 

00059 

»*ME  =«HFPQ_OC 

MODES 

00060 

CALL  RCINIT 

MODES 

00061 

ITYPE  =  5HMIXEE 

MODES 

00062 

N6sl 

MODES 

00063 

IF<  .NCR  .COPLAN.  ATC  .N5URF.EB  .2) 

MC  *  2 

MODES 

00064 

CALL  READMX(ICEGSC.M)«<EAD.RA)CIN,frs,)M5,LS,^.l,NIC,ID,ITYFE, 

MOOES 

00065 

1  LRSi FPQ.OC i  MtNfPARH,  IRR) 

MODES 

00066 

IF(IRR.rC.O)  CO  TO  0010 

MOOES 

00067 

MODES 

00068 

>*)AME  =»TTEXLOC 

MODES 

00069 

CALL  RDINIT 

MODES 

000 70 

ITYPE  =  9HMIXED 

MODES 

00071 

CALL  REA0MX(ICEC6ClM«EAC,RANDIN,^,)MS.LS.K*«,i,NID.ID,lTYPE. 

MOOES 

00072 

1  LRS.TPQ.OC.N,  N,  PARM,  IRR) 

MOOES 

00073 

IF(IRR.tC.O)  CO  TO  0010 

MODES 

00074 

MODES 

00075 

MOOES 

00076 

ZERO  OUT  THE  ROW  AM?  <d  * 

'INTERS 

MOOES 

00077 

DO  190  I  x  1,400 

MODES 

00078 

ISO)  s  0 

MODES 

00079 

190  CONTI  MJE 

MODES 

00080 

MODES 

00081 

MODES 

00082 

DETERMINE  AT  ART  INC  BOXES  AND  NUMBER  OF  BOXES  PER  CHORD. 

MOOES 

00083 

IYB1  «  (NSLBDVM)/? 

MOOES 

00084 

DO  900  NSsl,NSURF 

MOOES 

00083 

IF(NI.Ca.2)  CO  TO  200 

MOOES 

00066 

MC  «1 

MOOES 

00087 

NCH  «  MYBW 

MOOES 

00088 

NCF*  0 

MOOES 

00089 

ICN  «  I*BW  -  IYB1 

MOOES 

00090 

1X8  x  I XBW 

MOOES 

00091 

CO  TO  229 

MCCES 

00092 
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200  CONTINUE 

MQCES 

00093 

«  =  WYBW  ♦  1 

NODES 

00094 

MCH  =  MYBW  ♦  MYBT 

MODES 

00095 

«F  r  MTBW  *  NSU6DV 

NODES 

00096 

IFBT  =  «>®T-IXBW)/NSUBDV  ♦  1 

NODES 

00097 

225  CONTINUE 

NODES 

00098 

IV  B  =  IYB1  +  NCF 

NODES 

00099 

DO  250  J=NC,NCH 

NODES 

00100 

IS(J)  =  rc*.oc<iYB)  ♦  1.0 

NODES 

00101 

ITE1  =  TEXLOCUYB) 

NODES 

00102 

IF  (NSU6CV.EQ  .1 )  GOTO  240 

NODES 

00103 

IS<J)  =  (IS(J)-1CN>/NSUBCV  ♦  1 

NODES 

00104 

ITU  =  (ITCl-I  YB>/N6UeDV  ♦  1 

NODES 

00105 

240  CONTINUE 

MODES 

00106 

NOC(J)  =  ITEI-IS(J)  ♦  1 

NODES 

00107 

IYB  =  IYB  ♦  NSUBDV 

NODES 

00108 

250  CONTINUE 

NODES 

00109 

BOO  CONTINUE 

MODES 

00110 

CALL  ROPER 

NODES 

00111 

MODES 

00112 

MODES 

00113 

FI F©  OVERLAP  OF  2  PLAffCRMS  IF  THEY  ARE  NCN-CCPLANAR 

MODES 

00114 

ICVLAP  =  0 

MODES 

00115 

►4VTTRS  =  MX8UA1 

MODES 

00116 

IF(NSlNF.EH.l)  CO  TO  325 

NODES 

00117 

IF  (COPLAN)  CO  TO  324 

MODES 

00118 

IF(IFBT.GT.MXBW)  CO  TO  324 

MODES 

00119 

ICVLAP  =  MXBW  -  IFBT  ♦  1 

MODES 

00120 

NYCTRS  =  MXBT  ♦  ICVLAP  ♦  1 

MODES 

00121 

CO  TO  325 

MODES 

00122 

324  CONTINUE 

MODES 

00123 

FfNTRS  =  MXBT  ♦  1 

MODES 

00124 

325  CONTINUE 

MODES 

00125 

COMPUTE  POINTER  ARRAY  AfC  STORE  CN  MCCESC 

MODES 

00126 

REWIND  MCCESC 

MODES 

00127 

MCCES 

00128 

IPNTRM(l.l)  =  1 

MODES 

00129 

IPNTRM(2,l)  =  JS(1) 

MODES 

00130 

DO  320  I=2.NPNTRS 

MODES 

0GJ31 

IPNTRM(l.I)  =  IPNTRM«,I-1)  ♦  JOCCI-l) 

MCCES 

00132 

IPVTRM(2.I)  =  JSd) 

MCCES 

00133 

320  CONTINUE 

MODES 

00134 

CALL  RDINIT 

MODES 

00  L 

IPARHO)  =  ICVLAP 

MCCES 

00136 

I  TYPE  =  5HMIXEB 

MCCES 

00137 

CALL  VRTEMX(M0CESC,MXVRIT,RAFC<X),NFS,N«,LS,l*RiLV6,2,ID, 

MOC.S 

00138 

l  IPWTRMi  ITYPEi2i  NPNTRSi  PARMi  IRR) 

MCCES 

00139 

IF(IRfi.NE.O)  CO  TO  6030 

MCCES 

00140 

FIRST  LOOP  DETER  MINES  MCCE  SHAPES. 

MCCES 

0014t 

SECOK)  LOOP  DETERMINES  THICKNESS  SLOPES. 

MCCES 

00142 

MODES 

00143 

DO  S  0  IPASSrl  ,2 

MCCES 

00144 

!F(l  .SS.EO .2>  CO  TO  2100 

MCCES 

00145 

OOP  CN  NUMBER  of  surfaces 

MCCES 

00146 

DO  20 JO  MS=1  i  NSURF 

Mccrs 

001  4  T 

IF<NS.EO.NSURF)  CO  TO  330 

MCCCS 

00140 

MCCES 

0014l< 
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1FILE  =  IVPSC 

NODES 

00150 

REWDC  IVPSC 

MODES 

00131 

CO  TO  340 

MODES 

00152 

330  CONTINUE 

MOOES 

00153 

I  FILE  =  MCDESC 

MODES 

00154 

340  CONTINUE 

MODES 

00155 

c 

MODES 

00136 

c 

LOOP  CN  NLACER  CF  MODES 

MOOES 

00157 

DO  1500  m  =1  .KNCCES 

MODES 

001 58 

c 

MODES 

00159 

c 

MODES 

00160 

c 

ZERO  CUT  THE  DEFSL  ARRAY 

MODES 

00161 

DO  390  I  =  1.LM0CES 

BCSMDA 

00002 

DEFSL  (1 . 1 )  =  0.0 

MODES 

00163 

DEFSL  (2, 1)  -  0.0 

MODES 

00164 

330  CONTINUE 

MODES 

00165 

c 

BCSMDA 

00003 

c 

ZERO  OUT  THE  COEFFICIENT  ARRAY 

BCSMDA 

00004 

DO  355  I  =  1 ,21 

BCSMDA 

00005 

Ad)  =  0.0 

BCSMDA 

00006 

355  CONTINUE 

BCSMDA 

00007 

c 

MODES 

00166 

c 

INPUT  FIRST  RJUFCRM  IF  THERE  IS  A  TAIL  SECTION 

MODES 

00167 

IF(NS.EQ.l)  CO  TO  400 

MODES 

00166 

READ  (IVFSO  DEFSL 

MOOES 

00169 

c 

MODES 

00170 

c 

MODES 

00171 

400  CONTINUE 

MODES 

00172 

IFl.MOT.HiVMCCE)  CO  TO  450 

MODES 

00173 

CALL  RDINIT 

MODES 

00174 

IF(NS.EB.l.ANC.KM.EB.l)  FFS  =  2 

MODES 

00175 

IMAHE  =  CH  CCEF. 

MODES 

00176 

CALL  REACMX<ICECBC,MWEAD,RA)CIN,)FS,N«,LS,)M;,1.NID,ID,ITYPE, 

MODES 

00177 

l  LRSiAiMiNfFARMtIRR) 

MODES 

00178 

IF(IRR.(C.0>  CO  TO  6010 

MODES 

00179 

•FS  ~  0 

MODES 

00180 

c 

MODES 

00181 

CO  TO  551 

MODES 

00182 

450  CONTINUE 

MODES 

00183 

I  TYPE  =  HTYPEV 

MODES 

00184 

IF(NS.EB.2)  I  TYPE  =  NTYPET 

MOOES 

00185 

CO  TO  (301 1 502 >503) .  I TYPE 

MODES 

00186 

c 

MODES 

00187 

c 

READ  IN  POLYNOMIAL  COEFFICIENTS 

MOOES 

00188 

301  CONTINUE 

MOOES 

00189 

READ (NT5, 8010)  I DEC 

MODES 

00190 

IF  (IDEC  .LT.  0  .CR.  IDEC  .CT.  5)  CO  TO  6000 

MOOES 

00191 

8010  FORMAT (213) 

MODES 

00192 

MDEC  *  IDEC  ♦  1 

MODES 

00193 

DEC  s  MDEC 

MOOES 

00194 

CEC2*  DFC/2. 

MOOES 

00195 

NC  «  DCC4DCC2  ♦  DEC2  ♦  EPS 

MOOES 

00196 

READ  (NTS, 8013)  (A  (I)  »Isl  ,NC) 

MODES 

00197 

8013  FORMAT (TC10.0) 

MODES 

00198 

IFLAC  =  1 

MODES 

00199 

CO  TO  330 

MODES 

00200 

C 

MODES 

00201 

B75 


c 

READ  IN  DEFLECTIONS  AT  SELECTED  LOCATIONS  A»C  FIT  A  POLYNOMIAL 

MODES 

00202 

c 

OF  DECREE  I DEO  TO  THE  POINTS  USING  METHOD  OF  LEAST  SQUARES. 

MODES 

00203 

302 

CONTINUE 

MODES 

00204 

READ  (NTS, 8010)  IDEG.NFTS 

MODES 

00205 

IF  (I DEG  .LT.  0  .OR.  IDEG  .GT.  5)  CO  TO  6005 

MODES 

00206 

IF  (NPTS  .CT.  100  .OR.  NPTS  .LT.  1)  CO  TO  6005 

MODES 

00207 

READ  (NTS, 8020)  (XX(I )  ,YY  (I )  ,ZZ  (I ) ,  1=1  ,NPT$) 

MODES 

00208 

8020 

FORMAT  (6E10.0) 

MODES 

00209 

IDIM  =  1 

MODES 

00210 

CN  =  1.0 

MODES 

00211 

C 

MODES 

00212 

c 

CN  IS  A  SCALE  FACTOR  TO  REDUCE  THE  MAGNITUDE  CF  THE  NUMBERS 

MODES 

00213 

c 

IDIM  IS  A  DIMET6I0N  VARIABLE  SET  TO  1  TO  ITOICATE  FIT  IS 

MODES 

00214 

c 

BEING  MADE  ON  REAL  VALUES  .  IDIM  =  2  FOR  CCHFLEX  Z  VALUES. 

MODES 

00215 

CALL  FITTER(ICEG,NPTS,XX,YY,2Z,A,CN,IDIM> 

MODES 

00216 

c 

MOOES 

00217 

I  FLAG  =  2 

MOOES 

00218 

K5EG  =  IDEG  ♦  1 

MODES 

00219 

DEG  =  IDEG  ♦  1 

MODES 

00220 

DEG2  =  CEG/2. 

MODES 

00221 

K  =  DEG*DEG2  *  CEG2  +  EPS 

MODES 

00222 

c 

MODES 

00223 

c 

MODES 

00224 

530 

CONTINUE 

MODES 

00225 

c 

MODES 

00226 

c 

STORE  THE  COEFFICIENTS  ON  THE  THIRD  FILE  OF  THE  IGEC6C  FILE. 

MODES 

00227 

c 

IF  THE  COEFFICIENTS  ARE  TO  BE  PRINTED  THE  ONES  FOR  THE  FIRST 

MODES 

00228 

c 

SURFACE  MUST  BE  STORED  ON  A  SCRATCH  FILE  TEMPORARILY. 

MODES 

00229 

c 

MODES 

00230 

CALL  RDINIT 

MODES 

00231 

IF(l«.Ea.l.AfC.W.EQ.l)  »FS  =  2 

MODES 

00232 

IPAKMC3)  =  IDEG 

MODES 

00233 

IPARMM1  =  I  FLAG 

MODES 

00234 

I  TYPE  =  5HMIXED 

MODES 

00235 

CALL  VRTEMX(IGEC6C,MXVRIT,RAFC!0U,PFS,^,LS,FM(,LVB.1,ID, 

MODES 

00236 

1  A,  I TYPE,  1 ,  NC,  FARM,  IRR) 

MODES 

00237 

IF(IRR.NE.O)  GO  TO  6050 

MODES 

00238 

t€S  =  0 

MODES 

00239 

c 

MODES 

00240 

IF(.NOT.FRCOEF)  GO  TO  3550 

MODES 

00241 

IF(NS.Efl.2.CR.NSlRF.EQ.l)  GO  TO  3550 

MODES 

00242 

IF(^.EQ.l)  REWIND  IAICSC 

MODES 

00243 

c 

MODES 

00244 

CALL  VRTEHXdAICSC.MXWaT.RANrOU.NFS.KMS.LS.KFR.LWS.t  ,ID, 

MOD  EE 

00245 

1  A,  ITYPE, I ,  NC,  FARM,  IRR) 

MODES 

00246 

IF(IRR.NE.O)  GO  TO  6060 

MOOES 

00247 

c 

MODES 

00248 

3550 

CONTINUE 

MODES 

00249 

IF(NS.EQ.2.A>C.PM.EQ.1  )  REWJfC  IAICSC 

MOOES 

00250 

c 

MODES 

00251 

c 

EVALUATE  THE  POLYNOMIAL  EQUATION  FCR  DEFLECTI0N5. 

MODES 

00252 

c 

;E  PARTIAL  DERIVATIVE  WITH  RESPECT  TO  X  TO  GET  SLOPES. 

MODES 

00253 

c 

MODES 

00254 

c 

MOOES 

C0255 

551 

CONTI  WE 

MODES 

00256 

IF(fM.fC.l)  GO  TO  560 

MOCES 

00257 

IF (NS.CQ.2)  GO  TO  556 

MODES 

00258 

MODES 

00259 

CALCULATE  X,Y  COCRDINATES  PCR  EVALUATION  CF  POLYNOMIAL 

MODES 

00260 

=  XCENTR 

MODES 

00261 

Yl(t>  x  0.5*81  BET  A 

MOOES 

00262 

ir(N5LRF.Ea.2>  CO  TO  552 

MOOES 

00263 

**X  =  MA»<MXBW,MfBW> 

MODES 

00264 

CO  TO  554 

MODES 

00265 

552  CONTINUE 

MODES 

00266 

M-MX  =  HAXHMX8T  iMfBT,HYBW) 

MODES 

00267 

554  CONTINUE 

MOOES 

00266 

DO  555  1=  2, MMX 

MODES 

00269 

xi  <n  =  xiu-mBi 

MODES 

00270 

Y1(I)  x  Y1(I-1)*B1BETA 

MODES 

00271 

555  CONTINUE 

MODES 

00272 

CO  TO  560 

MODES 

00273 

MODES 

00274 

556  CONTINUE 

MODES 

00275 

XADJ  -  TUX  -  VUX 

MODES 

00276 

DO  557  1=1,  MMX 

MODES 

00277 

XI  (I)  =  XI  <I)  -  XADJ 

MODES 

00278 

557  CONTINUE 

MODES 

00279 

00  TO  560 

MODES 

00260 

MODES 

00281 

MODES 

00282 

560  CONTINUE 

MODES 

00283 

IP(NB.E8.2)  CO  TO  500 

MIXES 

00284 

IC  =  0 

MODES 

00285 

ILIM  =  MXBW 

MODES 

00286 

IBEC  x  1 

MODES 

00287 

MM  =  0 

MODES 

00288 

CO  TO  564 

MODES 

00289 

500  CONTINUE 

MODES 

00290 

IBEC  =  IFBT 

MOOES 

00291 

ILIM  x  MXBT 

MODES 

00292 

►CH  =  MYBW 

MODES 

00293 

IC  *  0 

MODES 

00294 

IUP  =  MXBW 

MODES 

00295 

IP  (COPUN)  I  UP  =  IFBT-1 

MODES 

00296 

DO  563  I -1,1 UP 

MODES 

00297 

IC  s  IC  ♦  JQC(I) 

MOOES 

00296 

563  CONTINUE 

MODES 

00299 

564  CONTINUE 

MODES 

00300 

DO  575  IX=IBEC,ILIM 

MODES 

00301 

I  x  IX 

MODES 

00302 

tr<N6.Ea.2>  i  *  ix  ♦  icwup 

MODES 

00303 

»<1>  xl. 

MODES 

00304 

DO  561  IP=2,MCEC 

MODES 

00305 

561  XPIIP)  x  XP(IP-l)  «  XI  (IX) 

MODES 

00306 

Jlx  J$(I) 

MOOES 

00307 

JT«  J0C<m  Jt  -1 

MODES 

00306 

DO  570  JxjI.JT 

MOOES 

00309 

IC  x  IC  ♦! 

MOOES 

00310 

II  «  I«CJ»NCH) 

MODES 

00311 

IT  «  IB  ♦  NQCO+NCH)  -1 

MODES 

00312 

IPdX.LT.IB)  CO  TO  570 

MODES 

00313 

IP(IX.CT.IT)  CO  TO  570 

MODES 

00314 

VP(1)  xl. 

MODES 

00313 
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CO  562  JP  =2,MDEC 

MODES 

00316 

562  TP(JP)  =  YP(jP-l ) *Y1  (J) 

NODES 

00317 

0  =  Ad) 

MODES 

003)8 

*  3  0.0 

MODES 

00319 

IF  CMDE&  .LT.  2)  CO  TO  567 

BCSMDA 

00008 

IA  =  1 

MOOES 

00320 

DO  565  L2=2,MDE0 

MODES 

00321 

DO  565  L3=1,L2 

MODES 

00322 

LA  =  L2-L3+1 

MODES 

00323 

IA  3  IA  A  t 

MCCES 

00324 

t  =  D  ♦  XP(L4)*YP<L3)*A<IA) 

MODES 

00325 

IF(LA.Ea.l)  CO  TO  565 

MODES 

00326 

L5  =  LA  -  1 

MCCES 

00327 

S  =  S  ♦  L5*XP(L5)*yP(L3>*A<IA) 

MCCES 

00328 

565  CONTINUE 

MODES 

00329 

567  CONTINUE 

BCSMDA 

00009 

DEFSLd .  IC)  =  D 

MCCES 

00330 

DEFSL(2,IC)  =  S 

MODES 

00331 

570  CONTINUE 

MCCES 

00332 

575  CONTINUE 

MCCES 

00333 

CO  TO  900 

MCCFS 

00334 

MCCES 

00335 

READ  IN  DEFLECTIONS  AMD  SLOPES  AT  BOX  CENTERS 

MODES 

00336 

503  CONTINUE 

MODES 

00337 

IF(INTAPE.EQ.O.CR. INTAPE. B). 5)  CO  TO  700 

MODES 

00338 

MCCES 

00339 

MCCES  ON  TAFE.  CALL  SPECIAL  ROUTINE  TO  HANCLE. 

MODES 

00340 

CALL  TAFXCINS.NN.DEPSL) 

MCCES 

00341 

CO  TO  900 

MODES 

00342 

TOO  CONTINUE 

MCCES 

00343 

lFOC.Ea.2J  CO  TO  720 

MODES 

00344 

MCCES 

00345 

FIRST  PLANECRN 

MCCES 

00346 

NCH  =  MYBW 

MCCES 

00347 

*C  =  1 

MCCES 

00348 

CO  TO  725 

MCCES 

00349 

720  CONTINUE 

MCCES 

00350 

HZ  =  HTBW  ♦  1 

MCCES 

00351 

NCH  =  NfBW  ♦  WBT 

MCCES 

003 ‘>2 

MCCES 

00353 

READ  AND  STORE  DEFLECTIONS 

MCCES 

00354 

725  CONTINUE 

MCCES 

00355 

DO  750  J=NC.NCH 

MCCES 

00356 

1ST  r  IS(J> 

MCCES 

00357 

NC  s  NOCIJ)  ♦  1ST  -  1 

MCCES 

00358 

JSUM  =  0 

MCCES 

00359 

I TROW  r  1ST 

MCCES 

00360 

IF(.MOT.COPLAN.AJC.N5.Ea.2>  I TROW  s  1ST  ♦  IOVLAP 

MCCES 

00361 

DO  7X3  I=1,ITRCW 

MCCES 

00362 

730  JSUW  3  JSUM  ♦  JCCdJ 

MODES 

00363 

JSL-  :  JSUM  -  JCCdTRCW)  ♦  1 

MOCES 

00364 

REA  :nt5,9015)  (C06 (I )  1 1  =  131  iNO 

MOCES 

00365 

DO  750  I  =  I3T,MC 

MCCES 

00366 

IX  '  I 

MOCES 

00367 

IF(. 'IOT.COPUN.AJC.NS.EO.2)  IX  =  I  ♦  IOVLAP 

MCCES 

00368 

I SUC  =  JSUM  ♦  J  -  JS(IX)  -  NC  ♦  1 

MOCES 

00369 

dcfslo .isuei  3ccc<n 

MCCES 

0037' 

B78 


V  V  V  WWW 


JSUM  =  JSUM  ♦  JQC(IX) 

750  CCNTINUE 

c 

C  READ  A>C  STORE  SCOPES 

DO  775  J=NC,KH 
1ST  =  IS(J> 

*¥.  =  NOC(J)  PlST  -1 
JSUM  =  0 
ITRCMs  1ST 

IF(.N0T.CCPUN.APC.NS.EB.2>  1TRCW  =  1ST  ♦  ICVCAP 
DO  770  1=1,  mow 
770  JSUM  =  JSUM  ♦  JOC(I) 

JSUM  =  JSUM  -  JOCdTRCVA  ♦  1 
READ  (NTS  ,901 S)  (DCR(l)  ,I=IST,MO 
DO  775  I=IST,N( 

IX  =1 

1F(.N0T .C0Fl_AN.AH3.fB. 03. 2)  IX  =  I  +  ICMJkP 
I  SUB  =  JSUM  ♦  J  -  JS(1X)  -  NC  ♦  1 
DFFSCt2.ISUB)  =  DCS(I) 

JSUM  =  JSUM  ♦  JOC(IX) 

775  CONTINUE 
900  CONTINUE 
C 

C  VKITE  WE  DEFSL  ARRAY  ONTO  MCDESC  FILE 

IF(NS.EB.NSURF)  CO  TO  925 
VRITE  (IFILE)  DEF5C 
CO  TO  950 
925  CONTINUE 
CAUL  RDINIT 
I  TYPE  =  5HMIXED 
N  =  IPNTRM<1,NPNTRS)-1 

CAUL  VRTEMXdRLE,MX4UT,RAfCCU,NF5,P*6,LS,fM<,U«6,2.ID, 

1  DEF5C,  ITYPE,2,Ni  PARM,  IRR) 

IF(IlW.tC.O)  GO  TO  6020 
950  CONTINUE 

IF(NS.NE.NSURF)  GO  TO  1500 
:^(.M0r.PRMQCS.AND..N3r.  PRCCEF)  GO  TO  1500 

PRINT  MODES,  COEFFICIENTS  CR  BCRH 

MUTE  (NT6.9500)  TITCE.Ml.WACH 
IF(.MOT.PRCOEF)  GO  TO  975 
!F<KTYPEM.EB.3>  GO  TO  960 

PRINT  COEFFICIENTS 

IF(NSURF.EQ.I)  GO  TO  960 
OUi  RDINIT 
I  TYPE  *  5HM1XED 

CALL  READMX(IAICSC,MWEAD,RAM)IN,NFS.NMS,LS,»MI,1  .NID.ID.ITYPE, 
1  IRS,  XX,  M,N,  PARM,  IRR) 

1FURR.NE.0)  GO  TO  6070 
C 

IFCC  «  l  PARM  <4  > 

IDGl  s  |PARM<3) 

CALL  PRECOFUCGl.XX.irCG) 

C 


MOOES 

00571 

MODES 

00372 

MODES 

00373 

MODES 

00374 

MODES 

00375 

MODES 

00376 

MODES 

00377 

MODES 

00378 

MOOES 

00379 

MODES 

00380 

MOOES 

00381 

MOOES 

00382 

MODES 

00383 

MODES 

00384 

MODES 

00383 

MOOES 

CO  386 

MODES 

00387 

MODES 

00388 

MODES 

00389 

MODES 

00390 

MODES 

00391 

MODES 

00392 

MODES 

00393 

MODES 

00394 

MODES 

00395 

MODES 

00396 

MODES 

00397 

MODES 

00398 

MODES 

00399 

MODES 

00400 

MODES 

00401 

MODES 

00402 

MODES 

00403 

MODES 

00404 

MODES 

00405 

MODES 

00406 

MODES 

00407 

MODES 

00408 

MODES 

00409 

MODES 

00410 

MOOES 

00411 

MOOES 

00412 

MODES 

00413 

MODES 

00414 

MOOES 

00415 

MODES 

00416 

MOOES 

00417 

MOOES 

00418 

MODES 

00419 

MODES 

00420 

MOOES 

00421 

MODES 

a  422 

MOOES 

OC  423 

MODES 

00424 

MODES 

00425 

MODES 

00426 

MODES 

00427 

B79 


960  CONTI  Hue 

MODES 

00428 

tfcNR.ea.t  .A^c.KPrPcw.ea. J)  co  to  975 

MOOES 

00429 

IF  (N5.EQ .2.  ANC.MTYPCT  .EB.3)  CO  TO  975 

MCCES 

0Q430 

CALL  B5ECCF<ICEC,A,IFUC) 

MODES 

00431 

C 

MODES 

00432 

975  CONTINUE 

MCCES 

00433 

NIOC  =  MXSW 

MODES 

00434 

IF (NSURF.EB  .2)  TKCV6  =  MX8T  ♦  ICWLAP 

MODES 

00435 

C 

MODES 

00436 

C  CALL  ROUTINE  TO  PRINT  THE  HCCE  SHAPES 

MODES 

00437 

CALL  MCOCUT(DEFSL.JS,JCC,NRC>fi,TH,  ICWLAP) 

MODES 

00438 

C 

MCCES 

00439 

1900  CONTINUE 

MODES 

00440 

ETC  FILE  IFILE 

MCCES 

00441 

M  =  1 

MCCES 

00442 

N  =  400 

MCCES 

00443 

CALL  WRTEHXdnLE.MXVfilT.RAhCOU.MPS.I^S.LS.NHT.LVe.l.ID, 

MCCES 

00444 

1  IS,  ITYFE,M,N,  FARM,  IRR) 

MCCES 

00445 

IF(IRR.TC.O)  CO  TO  6040 

MCCES 

00446 

C 

MOOES 

00447 

ETC  RLE  I RLE 

MCCES 

00448 

REWIfC  IFILE 

MCCES 

00449 

ZDOO  CONTI NLC 

MCCES 

00450 

CO  TO  3000 

MCCES 

00451 

2100  CONTINUE 

MODES 

00452 

C 

MCCES 

00453 

C  DETERMINE  THICKNESS  SLOPES 

MOCES 

00454 

C 

MCCES 

00455 

»CV  =  I  FNTRMIl  ,  NPNTRS)  -  1 

MCCES 

00456 

REWITC  ITSLSC 

MCCES 

00457 

IF(NTSLOP.TC.O)  CO  TO  2225 

MOCES 

00458 

C 

MOCES 

00459 

C  VRITE  ARRAY  CF  ONES 

MCCES 

004(50 

C 

v  ;es 

00461 

DO  2200  1=1, T«V 

MCCES 

00462 

DEFSLU.I)  =  1.0 

MCCES 

00463 

2200  CONTINUE 

MCCES 

00464 

C 

MCCES 

00465 

CALL  RDINIT 

MCCES 

00466 

I  TYPE  =  5HMIXEB 

MCCES 

0046 7 

M  =  1 

MCCES 

00468 

N  =  HJV 

MCCES 

00469 

CALL  W?TEMX(ITSLSC,MXW<IT ,RATCOU,  NFS,  N45  ,LS ,  TWr  ,  LC6 ,2,  ID, 

MCCES 

00470 

1  DEFSL,  I TYPE,  M,  N,  FARM,  IRR) 

MOCEF 

00471 

IF(IRR.NE.O)  CO  TO  6080 

MODES 

00472 

C 

MODES 

00473 

QC  FILE  ITSLSC 

MCCES 

00474 

REVflTC  ITSLSC 

MCCES 

00475 

CO  TO  3000 

MODES 

00476 

C 

MOCES 

00477 

2225  CONT.NUE 

MOCES 

004^8 

DO  2600  NS=1  i  NSURF 

MCCES 

00479 

IFINS.Ea.NSURF)  CO  TO  2230 

MOCES 

00480 

IFILE  =  IVPSC 

MCCES 

00481 

REWIND  IVPSC 

MCCES 

0C48? 

CO  TO  2240 

MCCES 

00483 

2230  CONTINUE 

MCCES 

0048' 

B80 


ipile  =  muse 

NODES 

00405 

2240  CONTINUE 

NODES 

00406 

NODES 

00407 

DO  2700  NSL=1  »NT5LOP 

MODES 

00408 

MOOES 

00489 

:  ZERO  OUT  THE  ARRAY 

NODES 

00490 

DO  2250  1=1,500 

MOOES 

00491 

tEFSL(l.I)  =  0.0 

NODES 

00492 

2250  CONTINUE 

MODES 

00493 

; 

NODES 

□0494 

IPO'S. E0.2)  CO  TO  2325 

MODES 

00495 

NCH  =  HYBW 

MODES 

00496 

NC  s  1 

MODES 

00497 

60  TO  235U 

MODES 

00498 

2325  CONTINUE 

MODES 

00499 

NC  =  HYBW  ♦  1 

MODES 

00500 

M34  =  HYBW  ♦  HYBT 

MODES 

□0501 

READ  (IVPSC)  CEPSL 

MOOES 

00502 

2350  CONTINUE 

MOOES 

00503 

» 

MODES 

00504 

DO  2500  J=HC,NCH 

MODES 

00505 

1ST  =  IS<J> 

MOOES 

00S06 

>*  =  MOCCJ)  *  1ST  -  1 

■ICSES 

00507 

JSUM  =  0 

MODES 

00*08 

ITROW  =  1ST 

MODES 

00509 

IF<.NOT.COFlAN.AW.NS.EB.2>  ITROW  =  1ST  ♦  ICNLAP 

MODES 

00510 

DO  2400  1=1,  ITROW 

MODES 

00511 

2400  JSUM  =  JSUM  ♦  JOC(I) 

MODES 

00512 

JSUM  =  JSUM  -  JOC(ITROW)  ♦  I 

MODES 

00513 

READ  (NT5.9015)  <006 <I) ,  I=IST,NO 

MODES 

00514 

DO  2300  I=ISTiM< 

NODES 

00515 

IX  s  I 

MODES 

00516 

IP(. NOT. COPLAN. AfC.NS.QJ. 2)  IX  =  I  ♦  ICVLAP 

NODES 

00517 

I SUB  =  JSUM  ♦  J  -  JS<IX)  -  NC  ♦  1 

MODES 

00518 

DEFSLU.ISUB)  s  1.  ♦  CAHC  *  DCS (I) 

MODES 

00519 

JSUM  =  JSUM  ♦  JCC(IX) 

NODES 

00520 

2300  CCMTINUE 

NODES 

00521 

C 

NODES 

00522 

IPINS.EB.NSURPI  CO  TO  2550 

NODES 

00523 

WIITC  (IVPSC)  CEPSL 

NODES 

00524 

60  TO  2600 

NODES 

00525 

2530  CONTINUE 

MOOES 

00526 

CALL  RDINIT 

MODES 

00527 

I  TYPE  =  5HMIXED 

MODES 

00520 

M  =  1 

NODES 

00529 

n>  «y 

MCOCS 

00530 

CALL  MT€MXUFILE,MXVRIT,RA>eOU,tFS,»e)LS,»fi,LV«,2,!D, 

MODES 

00531 

1  OCPSLi  !TYPE,M,N,PARM,IRR> 

MODES 

00532 

|P<!RR.7C.O)  60  TO  6060 

MODES 

00333 

C 

MOOES 

00534 

2600  CONTINUE 

NODES 

00535 

C 

NODES 

00336 

2700  CONTINUE 

MOOES 

C0S37 

END  PILE  I PILE 

NODES 

00538 

REWIN3  I PILE 

NODES 

00539 

2000  CONTINUE 

MODES 

00540 

3000  CONTINUE 

MODES 

00541 

B81 


c 

MCCES 

00542 

901 5 

FORMAT  (TE10.0) 

MCCES 

00544 

return 

MCCES 

00545 

C 

MODES 

00546 

C 

INPUT  DATA  ERRORS 

MOOES 

00547 

C 

MODES 

00548 

*000  URITE  (MT6.9000) 

I  CEO 

MODES 

00549 

CO  TO  6199 

MODES 

00550 

9005  URITE  (NTS, 9000) 

I  DEG,  NPTS 

MCCES 

00551 

CO  TO  6199 

MODES 

00552 

C 

MCCES 

00553 

c 

AN  ERROR  FROM  REACINO  OR  WRITING  A  MATRIX  FROM  TAPE  OR 

MCCES 

00554 

c 

DISK  FILE  OCCURRED.' RE  I  NT  MESSAGES  AUC  FLUSH 

MCCES 

00555 

c 

MCCES 

00556 

8310 

CONTINUE 

MCCES 

00557 

URITE  (NT6.9010) 

I GEC6C, IRR 

MCCES 

00558 

URITE  (NT6.9011) 

MNAME 

MODES 

00559 

CO  TO  6100 

MCCES 

00560 

*020 

CONTINUE 

MCCES 

00561 

URITE  (NT6.9020) 

MCCESC, IRR 

MCCES 

00562 

URITE  (NT6,9021> 

NM 

MCCES 

00563 

CO  TO  6100 

MCCES 

00564 

c 

MODES 

00565 

0030 

CONTINUE 

MODES 

00 566 

URITE  (NT6.9020) 

MCCESC, IRR 

MCCES 

00567 

URITE  (NTS, 9022) 

MODES 

00568 

C 

MCCES 

00569 

CO  TO  6100 

MODES 

00570 

0040 

CONTINUE 

MCCES 

00571 

URITE  (NT6.9020) 

MCCESC, IRR 

MCCES 

00572 

URITE  (NT6.9Q23) 

MCCES 

00573 

CO  TO  6100 

MCCES 

00574 

c 

MCCES 

00575 

0050 

CONTINUE 

MCCES 

00576 

URITE  (NT6.9050) 

ICEC6C,  IRR 

MCCES 

00577 

URITE  (NT6.9051  > 

KM 

MCCES 

00578 

CO  TO  6100 

MCCES 

00579 

c 

MCCES 

005a, 

8060 

URITE  (NT6.9050) 

IAICSC , IRR 

MCCES 

00581 

URITE  (NT6.9051) 

UN 

MCCES 

0058? 

CO  TO  6100 

MCCES 

j05E  i 

c 

MCCES 

0058-'. 

«OTO  CONTINUE 

MCCES 

00585 

URITE  (NT6.9070) 

ImICSC.IRR 

MCCES 

00586 

URITE  (NT6.9071) 

UN 

MCCE  . 

00587 

CO  TO  6100 

MCCES 

00588 

c 

MCCES 

00589 

*080 

CONTI  NJE 

MODES 

0(3590 

URITE  (NT6.9080) 

I TSLSC ,  IRR 

MCCES 

00591 

URITE  (NT6.9081) 

NSL 

MCCES 

00592 

C 

MCCES 

00593 

C 

MCCES 

00594 

MOO 

CONTINUE 

MOOES 

00595 

URITt  (NT6.9101) 

ID (1 ) ,  10 (2) 

MCCES 

00596 

URITE  (NT6, 9102) 

PARM,  I  FARM 

MODES 

00597 

UR  I  TE(NT6,9103) 

URS.UNS 

MCCES 

00  598 

UR!TE(NT6,9104) 

I  TYPE,  M,  N 

MCCES 

005 

B82 


6199  CONTINUE 

WRITE(NT6,9900) 


CALL  FLUSH  (1) 


7003  FCRKAT«C  PREVIOUS  HCCES  AM)  GEOMETRY  HAVE  BEEN  SPECIFIQi.  *  ) 

7010  FORMAT (86H0444  WARNING  -  PREVIOUS  MODE  SHAPES  HAVE  BEEN  SPECIFIED, 

1  BUT  GEOMETRY  HAS  CHANGED.  ***  ) 

7015  FORMAT  (8OH0*-**  ERROR  -  PREVIOUS  MCCE  SHAPES  HAVE  BEEN  SPECIFIED,  B 
ivrr  THE  GECM  HAS  CHANGED.  /  13X.41HPREVIOUS  HCCE  SHAPES  WERE  AT  BOX 

2  CENTERS.,  26X.4H  444  ) 

9000  FORMAT  (43K04**  ERROR  -  SPECIFIED  POLYNOMIAL  DEGREE  OF  15, 

1  22H  IS  OUTSIDE  LIMITS,  OR,  I6.24H  IS  TOO  WANT  POINTS  44*  ) 

9010  FORMAT (53H0***  ERROR  -  WILE  READING  THE  GEOMETRY  SCRATCH  FILE  A10 
1,  IfH,  ERROR  CCCE  =  14, AH  444  ) 

9011  FORMAT (5X.32HAN  ATTEMPT  WAS  WADE  TO  READ  THE  A6,  8H  MATRIX.//) 

9020  FORMAT (52H04*4  ERROR  -  WILE  WAITING  ON  THE  MCCE  SCRATCH  FILE  *10, 

1  13H,  ERROR  CCCE  =  I4.4H  ***  ) 

9021  FORMAT  (5X.40HAN  ATTEMPT  W1S  MADE  TO  WRITE  MCCE  SHAPE  13,//) 

9022  FORMAT (5X.47HAN  ATTEMPT  WAS  MADE  TO  WRITE  THE  POINTER  ARRAY.  //  ) 

9023  FORMAT (5X.41HAN  ATTEMPT  WAS  MADE  TO  WRITE  INDEX  ARRAY.  //) 

9050  FORMAT (57H0***  ERROR  -  WILE  WRITING  THE  COEFFICIENT  ARRAY  ON  FILE 

1  AlOilSH,  ERROR  CCCE  =  I4.4H  4*4  ) 

9051  FORMAT (5X.44HAN  ATTEMPT  WAS  MADE  TO  WRITE  FOR  MCCE  SHAPE  14  ) 

9070  FORMAT  (WHO***  ERROR  -  WILE  READING  THE  COEFFICIEN.  ARRAY  FROM  FI 
1LE  A10.15H,  ERROR  CCCE  =  I4.4H  4*4  ) 

9071  FORMAT  (5X.43HAN  ATTEMPT  WAS  MADE  TO  READ  FOR  MCCE  SHAPE  14  ) 

9060  FORMAT (5€H0*44  ERROR  -  WILE  WRITING  CM  THE  THICXNESS  SLOPE  FILE 

1  2X,A10,15H,  ERROR  CCCE  =  ,’4,4H  44*  ) 

9081  FORMAT (5X.45HAN  ATTEMPT  WAS  MADE  TO  WRITE  THICKNESS  SLOPE  14,//) 
9500  FORMAT (1H1.8A10,//  46X,4>  MCCc  SHAPE  MJMBER  4,13, 

1  /  46X.WACH  NU46ER  =*,Fll  .6,/46X,24(lH-> ./  ) 

9101  FCRMAT<5X.*MATR!X  ID  =  4,  A10,  110) 

9102  FORMAT  <5X,*PARAMETERS  4.10E1I.S,  /10X,  *  (INTEGER)  4,  17,  9111  > 

9103  FORMAT <5X,*nLE  SPACING  =  4., 13,4  MATRIX  SPACING  =  4,13) 

9104  F<RMAT<5X<4MATRIX  TYPE  -4, AID, 4,  DIME76IOED  (4I4.2H  X.I4.1H)  ) 
9900  FORMAT (40  ERROR  OCCURRED  IN  HCCES  SECTION  (MAIN  PROGRAM)  .4  ) 

EM) 


HCCES 

00900 

MOOES 

00601 

HCCES 

00602 

MODES 

00603 

MODES 

00604 

MODES 

00605 

HCCES 

00606 

HCCES 

00607 

MODES 

00608 

MODES 

00609 

MODES 

00610 

MODES 

00611 

MODES 

00612 

MODES 

00613 

MODES 

00614 

HCCES 

00615 

HCCES 

00616 

MODES 

00617 

MODES 

00618 

MODES 

U0619 

MODES 

00620 

MODES 

00621 

MODES 

00622 

MCCES 

00623 

HCCES 

00624 

MCCES 

00625 

MjCES 

00626 

MCCES 

00627 

MCCES 

00628 

MCCE-., 

00629 

MCCES 

00630 

MCCES 

00631 

MCCtS 

00632 

MCCES 

00633 

MCCES 

00634 

MCCES 

00655 

MCCES 

00636 

MODES 

00637 

SUBROUTINE  TAPMCC  <NS,*«,CEFSL) 

CIKNS1CN  DEFSL (2 .500)  i  0(500),  SI500) 

C 

C  THIS  BROGRAM  WILL  LEAD  MCCE  SHAPES  PRO  TAPE  IN  THE  SAME 

C  FWMAT  AS  BROCRAN  TEV059.  THE  BRCGRAM  WILL  BE  REPLACED  BY 

C  THE  AIR  FCRCE  FCR  ITS  USE  AND  BCE  I  NO  HAY  MCCIFY  CR  REPLACE 

C  AS  INPUT  TAPES  ARE  MCCIFIED  CR  REPLACED. 

C 

C  NS  -St,  FIRST  PLAfECRM 

C  =2,  SECOND  PUf^CRM 

C  **<  MODE  SHAPE  NLACER 

C  DEFSL  -  ARRAY  WORE  MCCE  SHAPES  FCR  ENTIRE  FLANFCRM(S)  IS 

C  STORED. 

C 

CO*Oi  /CECMTY/  CCPLAN,NSUBDV,XSUeCV,»6l*C2.NSUeCN,N5URF, 

1  Bl, BIBETA, BIS, B1BTAS.W_AX.W_AZ.PSIW, 

2  M)®WiMX8BWi  WfBWi  WfBBW,MXBSW.  WfBSW,MYBBSWt 

3  IXBW.XCENTR 
LOGICAL  COFLAN 

CO*4CN  /GEOG  /  TLAX,  TLA2  , PSIT,  MXBT,  WBT.HTBBT ,  MXBST iMYBST , 

1  HCBBST.tXBT.IXBST.CAfL 

CCM4CN  /FILES  /  NT5,Nr6,INTAFE,IfrsP,NPLAIC,NSFAIC,N0LrrP, 

1  lOUFSP.HCCESC.IVPSCiIGEOSC.IWTFSC.IAICSC 

CO**CN  /TAPEJCy  *fS,*MS,LS,**4R,  10(20). NIC,  ITYPE, LRS, LV6.M.N, 

1  PARM(IO)  ,  IRR 

DIMENSION  I FARM(IO) 

BBUI VALENCE  (FARM.  I  FARM) 

co*cn  /i*cex/  isaoo),Ncx(ioo),Js<ioo>,jocaaD) 

c 

LOGICAL  MUR EAC. RAMIN 
MISREAD  =  .FALSE. 

RAMIN  =  .FALSE. 

C 

CALL  PCI  NIT 
IF'W.TC.l)  GO  TO  710 
IF(N5.E0.1)  REWIM  INTAPE 
*♦6  =  2 
NFS  =  INFSP 
710  CONTINUE 

I  TYPE  =  5MMIXED 

CALL  REACMXdNTAPE.MXREAC, RAMIN, M’S, N€,LS,**R.l,  NIC,  ID,  ITYPE, 
l  LRS,  D,  M.N, FARM, IRR) 

IF(IRR.NE.O)  GO  TO  6020 
CALL  RDINIT 
I  TYPE  =  5HMIXED 

CALL  READMX(INTAPE,M>REAC,RAMIN,MS,N«,LS,*«R.I,  NID.ID.ITYPE, 
1  LRS,  S,  M,N,  FARM,  IRR) 

IF(IRR.NE.O)  CO  TO  6020 
C 

IF  (NS .  Efl  .2)  CO  TO  >20 
C 

C  i  RST  PLAMCRM 

*CH  =  MYBW 
*C  :  1 
CO  TO  725 
C 


C 


TAPMOC 

00002 

TAPM0C 

00003 

TAPMCO 

OOOOA 

TAPMOC 

00005 

TAPMOC 

00006 

TAPMOC 

00007 

TAPMOC 

00000 

TAPMCC 

00009 

TAPMOC 

00010 

TAPMCC 

00011 

TAPMOC 

00012 

TAPMOC 

00013 

TAPMCC 

00014 

TAPMCC 

00015 

CECMTY 

00002 

CECMTY 

00003 

CECMTY 

00004 

CECMTY 

00005 

CECMTY 

00006 

ceoe 

00002 

CE»e 

00003 

files 

00002 

files 

00003 

TAPEIO 

00002 

TAPEIO 

00003 

TAFEIO 

00004 

TAFEIO 

00005 

TAPMCC 

00020 

TAPMCC 

00021 

TAPMCC 

00022 

TAPMCC 

00023 

TAPMCC 

00024 

TAPMCC 

00025 

TAPMCC 

00026 

TAPMCC 

00027 

TAPMCC 

00028 

TAPMCC 

00029 

TAFMCC 

00030 

TAPMOC 

00031 

TAPMOC 

00032 

TAPMCC 

00033 

TAPMCC 

00034 

TAPMCC 

00035 

TAB*  r 

00036 

TAPMCO 

00037 

TAPMCC 

00038 

TAPMCC 

00039 

TAPMCC 

00040 

taphoo 

00041 

TAPMCC 

00042 

TAPMCC 

00043 

TAPMOC 

00044 

TAPMCC 

00045 

TAPMOO 

00046 

TAPMCO 

00047 

TAPMOO 

0004C 

TAFMCC 

OGCO 

second  plant crm 


*20  CONTINUE 

«  =  MYBW  ♦  1 
NCH  =  MYBW  ♦  NYBT 
C 

C  STORE  DEFLECT  I  OF*  AND  SLOPES 

*25  CONTINUE 
ITS  =  0 

DO  *50  J=NC,NCH 
1ST  =  IStJ) 

Ml  =  NOC(J>  ♦  1ST  -  1 
JSUH  =  0 
DO  *30  1=1, 1ST 
*30  JSUH  =  JSUH  ♦  jcctn 

JSUH  =  JSUH  -  JOC  (1ST)  ♦  1 
DO  750  I=IST,N< 

ITS  =  ITS  ♦  1 

I SUB  =  JSUH  ♦  J  -  NC  ♦  1  -  JS(I) 

DEFSLd  ■  ISUB)  =  D(ITS) 

DEFSLC2, 1SU6)  =  S<ITS) 

JSUH:  JSUH  *■  JOC  <11 
*50  CONTINUE 
C 

RETURN 

C 

C  AN  ERROR  DURING  READING  A  MATRIX  FROM  TAPE  CR 

C  DISK  FILE  OCCURRED.  PRINT  FCSSAOES  ANC  FLUSH 

C 

6010  CONTINUE 
€020  CONTINUE 

VRITE  (NT6.9020)  MOCESC.IRR 
WJITE  (NT 6 ,9021)  FM 
6100  CONTINUE 

WIITE  (NTS,  9101)  10(1). ID(2) 

MHTE(NT6,9102)  FARM,  I  FARM 
WUTE(NT6,9103)  FFS.N4S 
WSITE(NT6,9104)  ITYPEiHiN 
WHTE<NT6,9900> 

c 

CALL  FLUSH  (1) 


TAPMCC  00050 
TAPHCD  00051 
TAPMCC  00052 
TAPMCC  00053 
TAPMCC  00054 
TAPMCC  00055 
TAPHCD  00056 
TAPHCD  0005* 
TAPHCD  00058 
TAPHCD  00059 
TAPHCD  00060 
TAPHCD  00061 
TAPHCD  00062 
TAPHCD  00063 
TAPHCD  00064 
TAPHCD  00065 
TAPHCD  00066 
TAPHCD  0006* 
TAPHCD  00068 
TAPHCD  00069 
TAPMCO  000*0 
TAPHCD  003*1 
TAPMCC  000*2 
TAPHCD  000*3 
TAPHCD  00074 
TAPHCD  000*5 
TAPHCD  000*6 
TAPHCD  000*7 
TAPHCD  000*8 
TAPHCD  000*9 
TAPHCD  00080 
TAPHCD  00081 
TAPHCD  00082 
TAPHCD  00083 
TAPMCO  00084 
TAPMCO  00085 
TAPHCD  00086 
TAPHCD  0008* 
TAPMCC  00088 


C  TAPHCD  00089 

9020  FORMAT (S4H0***  ERROR  -  MULE  READING  FROM  THE  HCCE  SCRATCH  FILE  TAPMCO  00090 

1  A10.15H,  ERROR  CODE  =  I4.4H  ***  )  TAPHCD  00091 

9021  FORMAT (5X.39HAN  ATTEMPT  VftS  MACE  TO  READ  HCCE  SHAPE  13,//)  TAPMCO  00092 

9101  FORMAT (5X.4MATR IX  ID  =  *,  AIO,  110)  TAPMCO  00093 

9102  FORMAT (5X.4PARAMETERS  *,10E11.3,  /10X,*(lNTECER>*,  I*.  9111  )  TAPMCC  00094 

9103  FORMAT (5X, 4#ILE  SPACIMG  =  *,13,*  PMTRIX  SPACING  =  *,13>  TAPHCD  00095 

9104  FORMAT (5X.444ATRIX  TYPE  -*,A10,*,  DIMENSIONED  <*I4,2H  X.I4.1H)  )  TAPHCD  00096 

9900  FORMAT (40  ERROR  OCCURRED  IN  MODES  SECTION  (SUBROUTINE  TAPHCD).*  FTNXJ  00044 

1  )  FTNX1  00045 

DC  TAPHCD  00098 


885 


SUBROUTINE  ROPER 


C  SUBROUTINE  TO  DETERMINE  THE  BOXES  ON  EACH  ROM  THAT  SHOULD 

C  HAVE  MCCE  SHAPES. 

C 

C  ISO)  -  ROW  INCES  OF  FIRST  PUNFCRM  BOX  FCR  CHORD  J. 

C  NJOCO)  -  NUN«ER  OF  FLA  NF CRH  BOXES  ON  CHORD  J 

C  JS(I)  -  CCL  INCEX  OF  FIRST  PUNFCRM  BOX  FCR  SPAN  I. 

C  JOC(I)  -  NUMBER  OF  BOXES  BETWEEN  FIRST  ANC  LAST  PLANFCRH 

C  BOX  ON  SPAN  I 

C 

c 

COMMON  /CEGMTY/  COPUN,  NSUBDV,  XSUBDV,  NSUBD2 ,  NSUBCN,  N6URF, 

1  B1,B1BETA,B1S,B1BTAS,VEAX,VUZ,PS1W, 

2  MXBW,  HXBBW,  WBW,  MfBBW,  MXBSW,  HfBSW,  MYBBSV, 

3  I X8W,  XCENTR 
LOGICAL  COPUN 

COMMON  /CEOM2  /  TUX,TUZ,PSlT,MXBT,NttBT,MfBBT,MXBST,N*BST, 

1  NTBBST.IXBT.IXBST.CAPL 

COPNC3N  /INCEX/  IS(100»,N0C(100),JS(100),JOCa00) 

IF(COPUN)  CO  TO  100 
NO)  =  NfYBW 
MXB  =  HXBW 
CO  TO  200 
100  CONTINUE 

NCH  =  MTBW  ♦  MYBT 
NOE  s  NXBT 
200  CONTINUE 

DO  500  I  =  l.MXB 

jsd)  =a 

JOC(I)=0 

JCUT  =  0 

DO  400  J=1  .NCH 

IF  (I  .LT.IS(J) )  CO  TO  400 

iust  =  is<j>  +  nocij)  -i 

I F C I  .CT.IUST)  CO  TO  400 
IF(JSCI)  .NE.O!  CO  TO  300 
JS(I>  =  J 

IF(J.CT.NfTBW)  JS<I)  =  J  -  MYBW 
300  CONTINUE 

IFIJCUT.EB.l)  CO  TO  400 
JV  =  J 

IF(J.CT.MVBW)  JV  =  J  -  MTBW 
IF (JV.LT. JS<1 )  >  CO  TO  350 
JOC(I)  =  JV-JSU)  +1 
CO  TO  400 
350  CONTINUE 

JOCU)  =  JSCD-JV  ♦  JOCII) 

JS(I)  =  JV 
JCUT  =  I 
400  CCNfTl  NT E 
425  CONTI  JE 
500  CONTI' LE 
C 

C  CALCUUTE  FCR  SECOND  PUNFCRM,  THIS  IS  CH.Y  USED  FCR 

C  NON  COPLANAR  PUNECRHS. 

JF(NSURF.CO.l)  CO  TO  1500 


ROPER 

00002 

ROPER 

00003 

ROPER 

00004 

ROPER 

00005 

ROPER 

00006 

ROPER 

0000? 

ROPER 

00008 

ROPER 

00009 

ROPER 

00010 

ROPER 

00011 

ROPER 

00012 

ROPER 

00013 

CECNTY 

00002 

GECHTY 

00003 

GCOMTY 

00004 

CECNTY 

00005 

CECNTY 

00006 

ceoe 

00002 

CECN2 

00003 

ROPER 

00016 

ROPER 

0001? 

ROPER 

00018 

ROPER 

00019 

ROPER 

00020 

ROPER 

00021 

ROPER 

00022 

ROPER 

00023 

ROPER 

00024 

ROPER 

00025 

ROPER 

00026 

ROPER 

0GG27 

ROPER 

00028 

ROPER 

00029 

ROPER 

00030 

ROPER 

00031 

RCPER 

00032 

ROPER 

00033 

ROPER 

00034 

ROPER 

00035 

ROPER 

00036 

RCPER 

00037 

ROPER 

00038 

RCPER 

00039 

ROPET- 

00040 

ROPER 

00041 

ROPER 

00042 

RCPER 

00043 

ROPER 

00044 

ROPER 

00045 

ROPER 

00046 

ROPER 

00047 

ROPER 

00048 

RCPER 

00049 

ROPER 

00050 

RCPER 

00051 

RCPER 

00052 

RCPER 

0U<  15' 
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IPICO^ANJ  CO  TO  1500 

a  HTBW  ♦  MTBT 

ROPER 

00054 

XM  a  MYBW  ♦  1 

ROPER 

00055 

l^*T  a  tI)«T-IXBW)/NSUeDV  ♦! 

ROPER 

00056 

ICNUP  a  0 

ROPER 

000S7 

tFtlFBT.ue.HlfflW)  ICMJkP  =  MXSW  -  JFBT  ♦  1 

ROPER 

00058 

»  1000  IalFBT.MWT 

ROPER 

00059 

IX  2  I  ♦  ICMLAP 

ROPER 

00060 

J51IX)  =  0 

ROPER 

00061 

JCC(IX>  =  o 

ROPER 

00062 

DO  800  J=JCH)NCH 

ROPER 

00063 

lFO.LT.  15(4))  CO  TO  800 

ROPER 

00064 

ILAST  a  IS(j)  ♦  NQc(j) 

ROPER 

0006S 

IPd.CT.ILAST)  GO  TO  800 

ROPER 

00066 

Hr<J$«X).Ea.O)  J5KIX)  =  J-MTBW 

ROPER 

00067 

JV  s  J-  KTBW 

ROPER 

00068 

jocax)  =  jv  -  jsdx)  ♦  i 

ROPER 

00069 

800  CONTINUE 

ROPER 

00070 

825  CONTINUE 

ROPER 

00071 

1000  CONTINUE 

ROPER 

00072 

1500  CONTINUE 

ROPER 

00073 

RETURN 

ROPER 

00074 

EH) 

ROPER 

00075 

ROPER 

00076 
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r>  a 


SIMOUTIfC  nTTER(M,N,X,r,2,C,CN,IDlH) 

DIMENSION  *  ra00>'  CUDIm.66, 

DI*CNSICN  AI  <6«)  .A<€e,66)  ,XP<U),YP(ii) 

DIMENSION  VS  (10) 

LOGICAL  CCMPLX 

*  '  KCfiK  CF  POLYNOMIAL  EQUATION 

X  ’  MTA  TO  FIT  CWVE  WOJW 

X  -  X  COORDINATE  CF  DATA  POINT 

Y  *  Y  COORDINATE  OF  DATA  POINT 
z  -  Z  COORDINATE  OF  DATA  POINT 
C  -  CUTRJT  COEFFICIENT  ARRAY 
CN  -  SCALE  FACTOR 
CN  -  SCALE  Factor 

IDIM  -  INDICATOR  OF  REAL  OR  C CNR. EX  FUNCTION 
=  1.  FUNCTION  is  real 
=  2.  FUNCTION  is  com  flex 

to  C^r*S!LD,I>C>elCNS  ^  FUf<T1CN  AK®  COEFFICIENTS 


DETER  HI  Ft  CAMBER  CF  CCEFFIENTs 


EPS  =  1 .0E-O4 
CCNPLX  =  .FALSE. 

IFUCIN.E8-2)  CCMPLX  =  TRUE. 

:  S.'f TOREU«  wcmtoe  cr  *rai*  rare. 

IFlCN.BB.I.r  )  CO  TO  J 5 
DO  5  I=t,N 
XII)  r  XID/CN 
YU)  =  Y  (I )/CN 
5  CONTINUE 
15  CCHlINUE 
XM  =  N  '  « 

*C=  XN/2. 

n:  s  »*x>e  ♦  xne  ♦  eps 

:e(nc.le.n)  co  to  25 

N  s  M-l 
CO  TO  15 
25  CONTINUE 

NAC  =  NC 

™E  *****  ***&  THAT  CAN  BE  CONFUTED  IN 
EACH  DIRECTION  AND  SET  UP  ORDER  of  SOLUTION. 

wvi  l 
*cx  s  M 

VS(1)  =  X(1 ) 

DO  f  1st , N 
DO  V 

IF<X.  ,).Ea.VS(J))  CO  TO  S3 
30  CONTINUE 
♦CV  :  tcv  ♦  t 
VS(NCV)  =  X(I ) 


fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

FI  HER 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter  I 

fitter  1 

fitter  I 

FITTER  ( 

fitter  ( 
fitter  c 
fitter  c 
fitter  c 
fitter  r. 
fitter  o 
fitter  o 
fitter  0 
fitter  0 
fitter  0 
fitter  a 
fitter  a 
FITItR  a 

fitter  tx 
fitter  a 
fitter  cx 
fitter  a 
fitter  oc 
fitter  oc 
fitter  oc 
fitter  oc 
fitter  oc 
fitter  00 
fitter  00 
fitter  00 


ER  000C2 
ER  00003 
ER  00004 
ER  00005 
ER  00006 
ER  0000 r 
ER  00008 
ER  00009 
SR  00010 
3R  00011 
SR  00012 
*  00013 
R  00014 
R  00015 
R  00016 
R  0001 7 
R  00018 
R  00019 
R  00020 

a  00021 

R  00022 
R  00023 
<  00024 
5  00025 
i  00026 
i  00027 
i  00028 
i  00029 
:  00030 
00031 
00032 
00033 
00034 
00035 
00036 
00037 
00038 
00039 
00040 
00041 
0004? 
0004 j 
00044 
00045 
00046 
00047 
00048 
00049 
00050 
00051 
00052 
00053 
00054 
00055 
00056 
00057 
00058 


c 

c 

c 


IFOeV-l.EQ.M)  CO  TO  65 

fitter 

00059 

55  CONTINUE 

fitter 

000 GO 

«0  CONTINUE 

fitter 

00061 

»cx  =  tc V  -1 

fitter 

00062 

65  CONTINUE 

fitter 

00063 

fitter 

00064 

»CV  =  1 

FITTER 

00065 

MDY  =  M 

fitter 

00066 

V5(l)  =  V  <1 ) 

fitter 

00067 

DO  80  1=1,  N 

fitter 

00066 

DO  TO  J=1,ECV 

fitter 

00069 

lFCr(I).Ea.VS(J))  CO  TO  75 

FITTER 

00070 

TO  CCNTINJE 

FITTER 

00071 

tcv  s  NCV  t  1 

fitter 

00072 

VS(tCV)  =  YU) 

fitter 

00073 

IFUCV-l.EO.M)  CO  TO  85 

fitter 

00074 

T5  CONTINUE 

fitter 

00075 

80  CONTINUE 

FITTER 

00076 

MDY  =  MJV  -  1 

fitter 

00077 

85  CONTINUE 

fitter 

00078 

fitter 

00079 

I TOT  =NC  *i 

FITTER 

oooeo 

ITOT1  =  I  TOT 

FITTER 

00081 

IFICCMPLX)  I TOT  =  ITOT  ♦  1 

FITTER 

00082 

FITTER 

00083 

ZERO  CUT  THE  A  ARRAY 

fitter 

00084 

fitter 

00085 

DO  95  1=1,  NC 

FITTER 

00C66 

C<1,I>  »  0.0 

FITTER 

00087 

iF(.NOr.CCMR-X)  CO  TO  90 

FITTER 

00068 

C(2,I)  =  0.0 

FITTER 

00089 

90  CONTINUE 

fitter 

00090 

DO  95  J=l,ITOr 

FITTER 

00091 

95  AU.J)  =  0.0 

FITTER 

00092 

FITTER 

00093 

DETER  HI  DEVIATION  EQUATION  A^C  SQUARE  THE  EQUATION 

FITTER 

00094 

fitter 

00095 

Aid)  =1.0 

fitter 

00096 

»(1>  =1.0 

fitter 

00097 

Vf<l)  =1.0 

FITTER 

00098 

m  =  N  ♦  1 

FITTER 

00099 

DO  ZOO  K=1,N 

FITTER 

00100 

DO  10  LsZ.m 

FITTER 

00101 

RFCU  =  XP(L-1)*X(K) 

FITTER 

00102 

YF<L>  =  VRIL-lMiYtK) 

FITTER 

00103 

10  CONTI  M* 

fitter 

00104 

fitter 

00105 

I  *  1 

FITTER 

00106 

DO  40  LXZ.NM 

FITTER 

00?.07 

DO  ZO  0*1,  L 

FITTER 

00108 

IL«  L  -  U.  41 

FITTER 

00109 

iriO-l.CT.NBY)  CO  TO  30 

FITTER 

00110 

ir<IL-l.CT.NDX)  CO  TO  KJ 

FITTER 

00111 

HIM 

FITTER 

00112 

Aid)  =  X8(IU*YP(0> 

FITTER 

00113 

ZO  CONTINUE 

FITTER 

00114 

30  CONTINUE 

FITTER 

00115 
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40  CONTINUE 

Atan>  =  z  (i  iK> 

IP(CCHPEX>  AI  (1*2)  =  Z(2,K) 
IF(X.CT.l)  CO  TO  45 
*  =  I 

I  TOT  =  NC  ♦  1 

iron  =  I  TOT 

IFICCMPLX)  ITOT  =  ITOT  ♦  1 
45  CONTINUE 
C 

DO  1100  1=1, NC 
DO  1100  J=I , ITOT 
ASAV  =  AId)*AI  <J) 

A(I  ■  J)=A  (I ,  JJ+ASAV 
1100  CONTINUE 
200  CONTINUE 
C 

C  SQUARE  ROOT  METHOD 

C  INTERMEDIATE  MATRIX 

DO  1200  1=1, NC 
I Ml  =  I-I 
TMP=0.0 

IF(I.EQ.l)  CO  TO  1150 
DO  1120  L  =1,1  Ml 
1120  TMP=  TMF+  A(L,I>**2 
1150  CONTINUE 

T  =  A  (I  ,1)  -  TMP 
IF(T.CT.EPS)  CO  TO  4 
A(I, I)  =  Q.O 
CO  TO  1200 
4  CONTINUE 

Ad, I)  =  SORT  (T) 

IFtAd,  D.CT.EPS)  CO  TO  1155 
Ad,  ITOT)  =  0.0 
CO  TO  1200 
1155  CONTINUE 
C 

US  =  1*1 

DO  1100  .  =  JS.ITOT 
TMP=  0.0 

IEd.EB.1)  CO  TO  1175 
DO  1160  L=1 , 1  Ml 

11 «  TMP  =  TMP  v  A(L, I) *A (L,U) 

1175  A  (I ,  J)  =(A<I  ,J)-TMP)/Ad  ,1) 

1100  CONTINUE 
1200  CONTINUE 
C 
C 

C  BACX  SUBSTITUTE  FCR  CCETTICIEMTS 

DO  1400  K=t,NC 
I  =  NC  -  X  ♦  1 
IPlsI  1 
TMPl  =  0.0 
TMP2  =  0.0 

IF<A,I, D.CT.EPS)  CO  TO  1325 
C<1  ,1)  =  0.0 

ificcmpcx)  c (2 , i )  =  o.o 


FITTER  00116 
FITTER  00117 
FITTER  00118 
FITTER  00119 
FITTER  00120 
FITTER  00121 
FITTER  00122 
FITTER  00123 
FITTER  00124 
FITTER  00125 
FITTER  00126 
FITTER  00127 
FITTER  00128 
FITTER  00129 
FITTER  00130 
FITTER  00131 
FITTER  00132 
FITTER  00133 
FITTER  00134 
FITTER  00135 
FITTER  00136 
FITTER  00137 
FITTER  00138 
FITTER  00139 
FITTER  00140 
FITTER  00141 
FITTER  00142 
FITTER  00143 
FITTER  00144 
FITTER  00145 
FITTER  00146 
FITTER  00147 
FITTER  00148 
FITTER  00149 
FITTER  00150 
FITTER  00151 
FITTER  00152 
FITTER  00153 
FITTER  00154 
FITTER  00155 
FITTER  00156 
FITTER  00157 
FITTER  00158 
FITTER  00159 
FITTER  00160 
FITTER  00161 
FITTER  00162 
FITTER  00163 
FITTER  00164 
FITTER  00165 
FITTER  00166 
FITTER  0016? 
FITTER  00168 
FI  HER  00169 
FITTER  00170 
FITTER  0017- 
FITTCR  GO  17; 
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CO  TO  1400 
1325  CCNT1NUE 

IFd . Efi.NCICO  TO  1375 

DO  1350  L=m,NC 

TXP1  =  TMP1  ♦  Ad,L)*CU,U 

IFI.NOT.CCMPLX)  CO  TO  1350 

TVIP2  =  TMP2  ♦  A(I  ,L)*C(2,L) 

1350  CONTINUE 
1375  CONTINUE 

C(1,I)  =  (A  d ,  ITOTD-TMP1  )/Ad ,  1 ) 

IF(.NOT.CCMfl.X)  CO  TO  1400 
CC.I)  =  CA (I  tITOT)  -TMP2J/A  d  ,1) 

1400  CONTINUE 
C 

c 

C  REORDER  THE  COEFFICIENTS  IN  CORRECT  POWERS 

C  OF  X  ANC  Y. 

C 

IF(NAC.EB.NC)  CO  TO  1475 

c 

12  =  1 
I  =  1 

DO  1440  L=2,)N 
DO  1420  LL-l.L 
IL  =  L  -UL  41 
1  =  1+1 

1F<IJL-1.LE.MDY.AH).IL-1.LE.KDX)  CO  TO  1410 
Xd)  n  0.0 
rdi  =  a.O 
CO  TO  1420 
1410  CONTINUE 

rz  =  12  ♦  i 

Xd)  =  C(l.IZ) 

IFICOMPLX)  Yd)  =  C(2,I2) 

1420  CONTINUE 
1440  CONTINUE 

c 

DO  1450  1=2, NIC 

cci.n  =  xd) 

IF(C0MP1.X)  C(2,I)  =  Yd) 

1450  CONTINUE 
1475  CONTINUE 
C 

c  eliminate  the  scale  factor  frch  the  coefficients, 

c 

IF<CN.EB.l.0>  CO  T<3  1700 
1=1 

CFs  1.0/CN 
DO  1600  L1=2iM4 
DO  1500  12=1  ,L1 
I  *  !♦» 

crt.n  *  c(i,d*cp 

Ct2,l)  a  Ct2,I)*CP 
1500  CONTINUE 
CP=  CP/CN 
1500  CONTINUE 
1700  CONTINUE 


FITTER 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

fitter 

FI .rER 

fitter 

fitter 

fitter 

fitter 

Fitter 


00173 
00174 
00175 
001 7$ 
00177 
00178 
00179 
00100 
00181 
00182 
00183 
00184 
00183 
00186 
00187 
00188 
00189 
00190 
00191 
00192 
00193 
00194 
00195 
00196 
00197 
00198 
00199 
00200 
00201 
00202 
00203 
00204 
00205 
00206 
00207 
00208 
00209 
00210 
00211 
00212 
00213 
00214 
00215 
00216 
00217 
00218 
00219 
00220 
00221 
00222 
00223 
00224 
00225 
00226 
00227 
0C228 
00229 
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c 

c 

c 


THE  C  ARRAY  NOW  CONTAINS  THE  COEFFICIENTS 


RCORN 

DC 


FITTER 

FITTER 

fitter 

fitter 

fitter 


00230 

00231 

00232 

00233 

00234 


u  u  u 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE  MOCOUTtCEFSL.JS.JCC, TROWS, >*t,ICWUP> 

DIMENSION  CEFSL(2,500>,JS(iaO>,JOC(100> 

DIMENSION  JW(15)  ,D$(50) 

CCK1CN  /GECMTY/  COPLAN, NSUBDV.XSUBDV.NJUBH.NSUBCN.NSURF, 

1  St, BIBETA, BIS, B1BTAS, VOX,  W_AZ,PSIW, 

2  MX8W,  MXSBW,  KfBW,  MTBBW,  MXBSW,  MYBSW.MYBBSW, 

S  DQW.XCENTR 

LOCI  CAL  COPUN 

COMMON  /FILES  /  NT5.NT6,  INTAPE,  ITrSP.NPUIC.NSPAIC.NOUTP, 

1  IOUFSP.MODESC.IVPSC.ICEOSC.IWrFSC.IAICSC 

COMMON  /PRC8LM/  XMAOt,  MODES,  NTSLQP,  TRVALS,  SMOOTH,  TCEG,CRCF1T, 

1  CXAIC.SUBDV.fLYWOOO 

LOCI  CAL  SMOOTH,  CR  C  FI  T  ,EXA  I C,  SUB  DV,K.Y  WOOD 

DIMENSION  SLCMAT (3) 

cam  valence  islomto,  imatj 

DATA  SLCMAT/10H<I3,3X,  ,10H  0,10HP,tSF7.3)  / 

DATA  IMAT1.IMAT2  /10H  0,10.  -0  / 

MODOUT  WILL  PRINT  THE  MODE  SHAPES  OUT  IN  RQ*COLUMN  FCRM 

DEFSL  -  MCO  SHAPES  IN  INTERNAL  STORAGE 

JS<I)  -  FIRST  COLUMN  FCR  MI  04  THESE  IS  A  MODE  SHAPE  ON  RON 
JOC(I)  -  MACES  OF  BOXES  BETVCEN  FIRST  AMI  LAST  PUM'CRM 
BCK  ON  ROW  I 
♦ROWS  -  MACES  CF  ROC 
»M  -  MODE  SHAPE  MACES 

ICVUP  -  MACES  OF  BOXES  CWERUP  BETWEEN  FUTfCRMS  FCS 
NON-COPUNAR  SURFACES 

I  MAT  *  1CM  0 

♦RETS  3  0 
DO  90  Isl, TROWS 
JL  »  JS<I)*J0C(I)-1 
IP(NSCTS.LT.JL)  WETS=JL 
99  CONTINUE 

JSCTS  «  (NBETS-D/15  ♦  I 
DO  1000  NPsl  ,2 

FI  Ml  LARGEST  VALUE 

VALUE  «  0.0 

DO  100  L  *1,500 

AVAL  «  ABSIDCFSUNP.U) 

IF (AVAL.CT. VALUE)  VALUE  *  AVAL 
100  CONTINUE 
PCM  «  1 
TSCALE  •  10. 

IFtVALUE.GC. 10.)  TSCALE  ■  O.t 
DO  110  M*1,S 
POM  •  PCM  *T SCALE 
TTEN  ■  VALUE  *  PCM 
IFtTTEM.CE.lO.I  GO  TO  110 
IFtTTEN.LT.l.  >  GO  TO  110 
TCA  •  N 
eo  TO  119 
110  CONTINUE 
♦FA*  0 


MQOOUT 

MQDQUT 

MQOOUT 

gecmty 

GECMTY 
GECMTY 
GECMTY 
GECMTY 
FILES 
files 
PRC8LM 
PRC8LM 
TRCBLM 
MCDOUT 
FTNX1 
MODOUT 
MCDOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
I  MOCOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
MCDOUT 
MODOUT 
MODOUT 
MODOUT 
MCDOUT 
MCDOUT 
MCDOUT 
MCDOUT 
MCDOUT 
MODOUT 
MODOUT 
MODOUT 
MODOUT 
MCDOUT 
MCDOUT 
MODOUT 
MODOUT 
MODOUT 
MCDOUT 
MQDQUT 
MODOUT 
MCDOUT 
MCDOUT 
NOOOUT 
MODOUT 
MCDOUT 
MCDOUT 
MCDOUT 


00003 
00004 
00002 
00003 
00004 
OOOOS 
00006, 
mnrg> 
00003 
00002 
00003 
00004 
00006 
00046 
00009 
00011 
00012 
00013 
00014 
0001 3 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
00037 
00038 
00039 
00040 
00041 
00042 
00043 
00044 
00045 
00046 
00047 
00048 
00049 
00050 
00051 
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113  CONTINUE 

jfivalue.le.i.oo)  gctoim 

c 

C  THE  ARRAY  MUST  BE  SCALED  DOWN. 

c 

*>X  3  -NPA 
I  MAT  s  lHiT2 
CO  TO  122 
C 

C  THE  ARRAY  MUST  BE  SCALED  UP. 

C 

120  CONTINUE 
W>X  3  NPA 
I  MAT  s  IMAT1 
122  CONTINUE 

I  MAT  s  I  MAT  ♦  NPA 
IP (NP.EB.2)  CO  TO  124 
VRITE  <NT6,9005)  NPX 
CO  TO  125 

124  CONTINUE 

VRITE  (NT6.9G10)  NPX 

125  CONTINUE 

DO  900  JPS=1,JSETS 
JBASE  =  <JPS-1)*13 
DO  ISO  JC=1,15 
190  JFH(JC)  =  JC  ♦  JBASE 
JL=15 

IPUPS.EB.JSETS)  JL=  NSETS  -  15*<JSETS-1> 
VRITE(NT6,9015)  (JFH(J)  ,J=1,JL) 

ION  s  0 
I  TOT  r  0 

DO  000  1=1 ,  PROWS 
C 

C  ZERO  OUT  fRINV  ARRAY 

DO  200  J=1 ,50 
200  CS(J)  s  0.0 
C 

C  PUT  THE  VALUES  INTO  fRINT  ARRAY 

ji  =  js<i> 

IPIJI.EB.O)  co  TO  eoo 
JL  =  JS<I)  ♦JOC(I)  -1 
DO  300  J=JI,JL 
itcx  s  it  am 

300  DS<J)  =  DEFSLIWMTOT) 

C 

C  PRINT  THE  OPCS  IN  THIS  SET 

JIP=<JPS-1)*15  ♦! 

JIL=  JIP  +14 
IF(JL.LT.JIP)  CO  TO  800 
IFUI.CT.JIL)  CO  TO  000 
IPIJIL.CT.JL)  JIL=JL 
M  =  I 

ir<I  4JIP.EQ.0)  CO  TO  350 
!F<I  1.E.NXBW)  CO  TO  350 
M  s  I  -IOVUP 
tr<IOV.NE.O)  CO  TO  350 
IOV  =  1 


MCCOUT  00052 
MCCOUT  00053 
MOtxxrr  00054 
MCCOUT  00055 
MCCOUT  00056 
MCCOUT  00057 
MCCOUT  00050 
MCCOUT  00059 
MCCOUT  00060 
MCCOUT  00061 
MCCOUT  00062 
MCCOUT  00063 
MCCOUT  00064 
MCCOUT  00065 
MCCOUT  00066 
MCCOUT  00067 
MCCOUT  00060 
MCCOUT  00069 
MCCOUT  00070 
MCCOUT  00071 
MCCOUT  00072 
MCCOUT  00073 
MCCOUT  00074 
MCCOUT  00075 
MCCOUT  00076 
MCCOUT  00077 
MCCOUT  00070 
MCCOUT  00079 
MCCOUT  00080 
MCCOUT  00081 
MCCOUT  00082 
MCCOUT  0CG83 
MCCOUT  00084 
MCCOUT  00085 
MCCOUT  00086 
MCCOUT  00087 
MCCOUT  00088 
MCCOUT  00089 
MCCOUT  00090 
MCCOUT  00091 
MCCOUT  00092 
MCCOUT  00093 
MCCOUT  00094 
MCCOUT  00095 
MCCOUT  00096 
MCCOUT  0(3097 
MCCOUT  00098 
MCCOUT  00099 
MOOCUT  00100 
MCCOUT  00101 
MOCOUT  00102 
MCCOUT  0010? 
MCCOUT  00104 
MCCOUT  00105 
MOCOUT  00106 
MOCOUT  00107 
MOCOUT  00108 
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t«ITE<NT6,9015) 

MCOOUT 

00109 

350  CONTINUE 

HOC  OUT 

00110 

W«ITE<NT6,SLC»*T>  N,  (CStJ)  ,  J=.tIP,JlL) 

NODCUT 

00111 

800  CONTINUE 

HCOOUT 

00112 

900  CONTINUE 

mcoout 

00113 

1000  CONTINUE 

MCOOUT 

00114 

RETURN 

MOOOUT 

00115 

9005  FCRM4T<1HC,46X,*CEFIECTI06  X  1  .OE  *,I2,/ 

47X.2K1H-)  ) 

MOCCUT 

00116 

9010  FCRMAT<1H0,//47X,*  SLOPES  X  l.OE  *,I2,/ 

47X.2K1H-)  ) 

MCOOUT 

U0117 

9015  FCRH4T (1H0i5X, 15(14, 3X) 

MOOOUT 

00118 

9020  FCRM4T (I3,3X,1  5F7.3) 

MCOOUT 

00119 

END 

MCOOUT 

00120 
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subroutipc  preccf<iceg,a,iir> 

CO*<N  /FILES  /  NT5.NT6, INTAPE, INFSP.NPLAIC.NSPAIC.NOUTP, 

1  ICUFSP.MCXESC.IVPSC.IOEOSC.IWTFSC.IAICSC 

DI*CWICN  A  (21)  ,BLNK<7)  ,BN<2<6) 

OJOI  VALENCE  (BLNU2)  ,BNK2<1>> 

DIMENSION  I XP(7) , IyP(7) 

DATA  BLN1  /  7*  1H  / 

C 

C  THIS  SUBROUTINE  PRINTS  THE  COEFFICIENTS  USED  IN  THE 

C  POLYNOMIAL  EQUATION  USED  IN  CALCULATION  OF  MCCE  SHAPES 

C 

C  I  DEO  -  DECREE  OF  POLYNOMIAL  EQUATION 

C  A  ARRAY  CF  COEFFICIENTS 

C  IFR  -  FLAO  INDICATING  HOW  COEFFICIENTS  ARE  OBTAINED 

C  =1,  READ  FROM  CARDS 

C  =2,  FROM  LEAST  SQUARES  SURFACE  FIT 

C 

IFUFK.EQ.l)  W?!TE<NTS,9055)  A(l) 

IFMPR.EB.2)  VfiITE(NT6,9065>  A<1) 

C 

IF(ICEG.EQ.O)  GO  TO  550 
IDO  =  2 
DO  520  Irl.IDEG 
NL  =  IM 
LDO  =  ICO  ♦  I 
DO  541  NXPrl  ,  MCL 
IXP(NXP)  =  NCL-NXP 
rYP(NXP)  =  NXF-1 
541  CONTINUE 

VKITE<NT6,90eO>  (BLN1  (NXP)  ,  I  XP(NXP) ,  tYP(NXP) ,  NXP=1 ,  NCL) 
W;ITE(NT6,906l)  <BP*2<NXF)  ,NXP=1  ,NCU 
WJITEiNT6,9062)  (A  <J)  ,  J=I  CEX.LCEX) 

IDO  r  LDEX  ♦  1 
320  CONTINUE 
550  CONTINUE 


PRECCF  00002 
FILES  00002 
FILES  00003 
PRECOF  00004 
PRECCF  00006 
PRECCF  00007 
FTNX1  00047 
PRECCF  oooce 
PRECOF  00009 
PRECCF  0001 0 
PRECCF  0001 1 
PRECCF  00012 
PRECOF  00013 
PRECCF  00014 
PRECCF  00015 
PRECOF  00016 
PRECCF  00017 
PRECCF  00018 
PRECCF  00019 
PRECCF  00020 
PRECCF  00021 
PRECOF  00022 
PRECCF  00023 
PRECCF  00024 
PRECCF  00025 
PRECCF  00026 
PRECOF  00027 
PRECCF  00028 
PRECOF  00029 
PRECOF  OOO-jO 
PRECOF  00)31 
FRECC  TJ032 
PRECCF  00033 
PRECCF  00034 
PRECCF  00035 


RETURN  PRECOF  00036 

9055  FORMAT <13X,  AMOCAL  POLYNOMIAL  COEFFICIENTS*  20X,*PRCM  CARD  INPUT*  PRECCF  00037 

1  /13X.29UH-)  /AO  CCNSTANTAi  /2X,l0.1H->  /  E12.4  )  PRECCF  00038 

9060  FCRMAT<1H0,6(A1 ,4HX  **  I1.4HY  **  II  ,3X)  )  PRECCF  00039 

9061  FCRMAT <1 X,  6(A1 , 10H - ,3X)  )  PRECCF  00040 

9062  FCRMAT(E12.4,5E14.4)  PRECCF  00041 

9065  FQRMAT(1H0.12X,*HCCAU  POLYNOMIAL  C0EFFICIENTS*/13X,  *BY  LEAST  SQUAR  PRECCF  00042 

1E3  SURFACE  Fm/t3X,29(!H-)//AO  CCNSTANT*/2X,10<lH->/  E12.4  )  PRECCF  00043 
ETC  PRECCF  00044 
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n  rt 


I  TYPE  =  5HMIXED 
MXARRY  =  GHATAB 

CAUL  REACMXtNSPAtC,M*<EAD,RArCIN,NF5,T*«,LS,rW<,500,NID,ID,JTYPE, 
1  UK.  ATAB.H.N,  PARH.IRR) 

IFURR.rC.O)  CO  TO  6060 
REVISE  SB  FA  I C 

IFtNV.rC.l)  CO  TO  555 


C  fRINT  THE  TABLE  OF  CONTENTS 

WIITE  (NT6.9215) 

9215  F<RMAT(1H1,14X,*SPATIAL  AIC  TAPE  TABLE  OF  CONTENTS*  /15X.34  <!H-> , 

1  //  SX , *NO. *  4X.*HACH*  6X,  4K1-VALUE*  6X,*ERRCR*  4X,*SIZE*,5X, 

2  *YBAR*  5X,*ZBAR*  /  ) 

PCELT  =  0 

DO  550  1=1,  MCST 
IFtAMKHdl.GT.O)  CO  TO  525 
PCELT  =  SCELT  +1 
CO  TO  550 

SE5  WdTE  (NT6.9020)  I,  AMACH (I /  .AKVALd ) , AERR (!) . ISIZE(I)  .YBARSd ) , 
1  VERTSd) 

550  CONTI MUE 

VR1TE  (NTS.9025)  NCELT 
C 

C  SEARCH  FCR  MATRICES  WITH  CORRECT  K-VAI.UE,  r«CH,  ERROR,  SIZE, 

ASO  YEAR. 

555  CCNTirCJE 
IVAL  =  a 
reiz  s  o 

DO  600  1=1,  NIST 

IFtABS  (AMACH  (I  J-XMACH)  .CT.l  .OE-05)  CO  TO  600 
IFtABS  tAKVAL  (I  >-Kl  >.GT.1.0E-07>  GO  TO  600 
IFtAEKRtD.GT.ERR)  CO  TO  600 
IF(ABS(VEKTS<I)-EL)  .CT.1.0E-04)  CO  TO  600 
IFtABS (YBAR-YBARS (I)  >  .  GT .  1  .OE-04  >  CO  TO  600 


C 

c 

c 


c 

c 

c 

c 


THERE  IS  A  COCO  MATRIX  ON  TAPE.  DETERMIfC  IF  SIZE  IS  ADEQUATE 
IF(IVAL.rC.O)  CO  TO  575 

lF(t#cOC.CT . ISIZE(I)>10.ArC.ERR .GT.AEKR <1  > )  CO  TO  600 

IVAL  s  I 

reiz  =  ISIZE(J) 

575  CONTINUE 

IF(IslZEd)  .CE.NRCW5)  CO  TO  BOO 

THE  SIZE  IS  NOT  LARGE  ENOUGH.  SEE  IF  THIS  IS  LARGER  THAN  ANT 
PREVIOUS  MATRIX. 


IF(ISIZEd)  .LE.NSIZ)  CO  TO  600 

IF  trROWS.  CT .  I  SIZE  (I )  *10.  AH).  ERR  .CT  .AERR  (I) )  CO  TO  600 

IVAL  *  I 

reiz  *  isizEd) 

600  CONTINUE 
C 

C  DETERMINE  IF  THERE  WtS  A  MATRIX  CN  TAPE  THAT  COULD  BE  EN. ARCED 

IF(I VAL.E9.0)  CO  TO  25 


VICM1IN  00095 
VI CHAIN  00096 
VICMAIN  00097 
VICMAIN  00098 
VICMAIN  00099 
VICMAIN  00100 
VICMAIN  00101 
VICMAIN  00102 
VICMUN  00103 
VICMAIN  00104 
VICMAIN  00105 
VICMAIN  00106 
VICMAIN  00107 
VICMAIN  00108 
VIOVdN  00109 
VIOMIN  00110 
VICMAIN  00111 
VIOVdN  00112 
VICMAIN  00113 
VICMAIN  00114 
VICWUN  00115 
VICWIN  00116 
VICMAIN  00117 
VICMAIN  00118 
VICMAIN  00119 
VICMAIN  00120 
VICMAIN  00121 
VICMAIN  00122 
VICMAIN  00123 
VICMAIN  00124 
VICMAIN  00125 
VICMAIN  00126 
VICMAIN  00127 
VICMAIN  00128 
VICMAIN  00129 
VICMAIN  00130 
VICMAIN  00131 
VICMAIN  00132 
VICMAIN  00133 
VICMAIN  00134 
VICMAIN  00135 
VICMAIN  00136 
VICMAIN  00137 
VICMAIN  00138 
VICMAIN  00139 
VICMAIN  00140 
VICMAIN  00141 
VJCMAIN  00142 
VICMAIN  00143 
VICMAIN  00144 
VICMAIN  00145 
VICMAIN  00146 
VICMAIN  00147 
VICMAIN  00148 
VICMAIN  00149 
VICMAIN  00150 
VICMAIN  00151 


C  CALCU^TE  2  PLANAR  AICS  IF  SUBDIVISION  IS  APPLIED. 

*#*  =  1 

ifinsubdv.ct.i)  w*  =  2 

WACS  =  WPATK  ♦  Nf*. 

DO  1000  NV  -  l.NVCS 
C 

C  SET  Kt  VALUE  IF  SUBDIVIDED  AIC 

C 

!F(Nf*.EQ.2.Af®.NV.Ea.NVCS)  Kl=  Kl/FLQAT (NSUBDV) 

C 

LEND  =  UERN. 

IF<NV.ED.NVCS.A*C.NFK.E».2)  LEND  =  LSKERN 
DO  100  1=1  .LEW 
C(I)  =  (0.  (0.) 

W<I>  =  <D.,0.) 

VU>  =  {0..0.1 
100  CONTINUE 
C 

ilQ  CONTINUE 

IF(NV.GT.NVCS-NMO  CO  TO  1G 
c 

c  READ  HAAIC  ARRAY  FROM  IGEC6C.  FIRST  FILE  MUST  BE  SKIPPED 

C  M?ICR  TO  FIRST  READ. 

C 

CALL  RDINIT 
IF(NV.fC.l)  CO  TO  200 
REWIAC  I ceo&c 
•flS  =  1 
200  CONTINUE 

I  TYPE  =  5HMJXED 
MXARRY  =  CHMUAIC 

CALL  REACMY(ICEcSC,M)fl;EADiRANDlN,NFStfWS,LSiI#45,2>NID1  ID,  ITYRE, 
I  IRS. KJAIC.M.NxOHB. FARM, IRR> 

IF«RR.fC.0>  CO  TO  601G 
C 

YBAR  =  PARMU) 
a  =  PARMI5) 


C 

C  DETER  MI  fC  IF  SPATIAL  AICS  ARE  CN  TAPE  AND  C€T  THEM 

C  IF  POSSIBLE. 

C 

NtST  =  0 

IF(.MOT.QSPAIC)  CO  TO  25 
C 

C  AICS  ARE  CN  TAPE.  GET  TABLE  OF  CONTENTS. 

rewind  ns  pa  it 

CALL  RDINIT 
W5  =  1 

I  TYPE  =  5HMJXED 

KXARRv  =  6HTA8 

CALL  REACMX<NSPAIC,MX|<eAD,RANDlN,irs,A*e,L3,l*«,500,NtD,ID,ITYPE, 

I  LRS,  TAB, M<ST,N,  FARM,  IRR) 

IFURR.tc.O)  CO  TO  6060 
C 

CALL  R  Cl  NIT 


VICMAIN  00038 
VI CHAIN  00059 
VICMAIN  00040 
VICMAIN  00041 
VICMAIN  00042 
VICMAIN  00043 
VICMAIN  00044 
VICMAIN  00045 
VICMAIN  00046 
"I CHAIN  00047 
VICMAIN  00048 
VICMAIN  00049 
VICMAIN  00050 
VICMAIN  00051 
VICMAIN  00052 
VICMAIN  00053 
VICMAIN  00054 
VICMAIN  00055 
VICMAIN  00056 
VICMAIN  00057 
VICMAIN  00058 
VICMAIN  00059 
VICMAIN  00060 
VICMAIN  00061 
VICMAIN  00062 
VICMAIN  00063 
VICMAIN  00064 
VICMAIN  00065 
VICMAIN  00066 
VICMAIN  00067 
VICMAIN  00068 
VICMAIN  00069 
VICMAIN  0GG7D 
VICMAIN  00071 
VICMAIN  00072 
VICMAIN  00073 
VICMAIN  00074 
VICMAIN  00075 
VICMAIN  0007$ 
VICMAIN  00077 
VICMAIN  00078 
VICMAIN  03079 
VICMAIN  00080 
VICMAIN  00081 
VICMAIN  00082 
VICMAIN  00083 
VICMAIN  00084 
VICMAIN  00085 
VICMAIN  00086 
VICMAIN  00087 
VICMAIN  00088 
VICMAIN  G0089 
VICMAIN  0009G 
VICMAIN  00091 
VICMAIN  00092 
VICMAIN  00093 
VICMAIN  00094 
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c 

C  CALCU^TE  2  PLANAR  *iCS  jF  SUBDIVISION  tS  APPLIED. 

«:| 

IF(NSUBDV.CT.l)  Nf*  =  2 
WCi  =  NSPATX  ♦  Nf* 

DO  1000  NV  =  1 iSVCS 

c 

C  SET  K1  VALUE  IP  SUBDIVIDED  AIC 

C 

IF<NHL.Ea.2.A7®.NV.EQ.NVCS>  Kl=  Kl/FLQAT (NSUBDV) 

C 

LEW  =  LKERN. 

IPCW.Ea.NVCS.AW.NW.E0.2)  LEW  =  LSKERN 
DO  100  1=1  .LEW 
C(D  =  C0..0.) 

W<U  =  <0.,0.) 

V(I)  =  <0.,0.) 

100  CONTINUE 
C 

ilO  CONTINUE 

IF<NV.GT.NVCS-NBO  CO  TO  1G 
C 

c  READ  MJAIC  ARRAY  FROM  ICEC6C.  FIRST  FILE  MUST  BE  SKIPPED 

C  BJICR  TO  FIRST  READ. 

C 

CALL  RDIWT 
IF(NV.Ke.l)  CO  TO  200 
RCWIfC  ICEQ6C 

♦rs  =  i 

200  CONTINUE 

I  TYPE  =  5H  MIXED 
MXARRY  =  6HMUAIC 

CALL  REAI>lxaGC''.6C.M»;EAD,RAACIN,WS,F*e,LS.M*,2,NIB,ID,ITYFe, 

1  LRS.KJAIC.M,  WOWS,  FARM,  IRR) 

IF(IRR.fC.O)  CO  TO  €010 
C 

YBAR  =  PAKM(4) 
a  =  MARM<5) 

*':1 

C 

c  DETER  MI  w  IF  SPATIAL  AICS  ARE  ON  TAPE  AND  GET  THEM 

C  IF  POSSIBLE. 

C 

mast  =  o 

IF<.NOr.C6P*jo  CO  TO  25 

c 

C  AICS  ARE  ON  TAPE.  CET  TABLE  CF  CONTENTS. 

REWIND  nspaic 
CAU  RDINIT 
tfi  =  l 

I  TYPE  =  5HMJXED 
KXARRv  s  6HTAB 

CALL  HEACMX(NSPAICiMWEAD,RAND!Ni WSim5,LSiNM?i500iNIDiIDiITYPE, 

1  LRSi  TAB, M<ST,N,  FARM,  IRR) 

IFIIRR.W.O)  CO  TO  6060 
C 

CALL  RCINIT 


VICMAIN  00058 
VICMAIN  00039 
VtCMAtN  00040 
VICMAIN  00041 
VICMAIN  00042 
VICMAIN  00043 
VICMAIN  00044 
VICMAIN  00045 
VICMAIN  00046 
“I CHAIN  00047 
VICMAIN  00048 
VICMAIN  00049 
VICMAIN  00050 
VICMAIN  00051 
VICMAIN  00052 
VICMAIN  00053 
VICMAIN  00054 
VICMAIN  00055 
VICMAIN  00056 
VICMAIN  00057 
VICMAIN  00058 
VICMAIN  00059 
VICMAIN  00060 
VICMAIN  00061 
VICMAIN  00062 
VICMAIN  00063 
VICMAIN  00064 
VICMAIN  00065 
VICMAIN  00066 
VICMAIN  00067 
VICMAIN  00068 
VICMAIN  00069 
VICMAIN  00070 
VICMAIN  00071 
VICMAIN  00072 
VICMAIN  00073 
VICMAIN  00074 
VICMAIN  00075 
VICMAIN  0007$ 
VICMAIN  00077 
VICMAIN  00078 
VICMAIN  00079 
VICMAIN  00080 
VICMAIN  00081 
VICMAIN  00082 
VICMAIN  00083 
VICMAIN  00084 
VICMAIN  00085 
VICMAIN  00086 
VICMAIN  00087 
VICMAIN  00088 
VICMAIN  G0089 
VICMAIN  0009C 
VICMAIN  00091 
VICMAIN  00092 
VICMAIN  0009J 
VICMAIN  0009 A 
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c 

C  THESE  IS  A  MATRIX  THAT  CAN  BE  ENJkRGeC. 

AMACHUVAL)  =  -AMACHUVAL) 

WITTE  (NT6.9030)  IVAL.  AEKR  (I  VAL)  .  ISIZE(I  VAU  .  WOWS 
C 

C  SPACE  TO  CORRECT  ARRAY  ON  TAPE 

CALL  RCINIT 
W6  =  <IVAL-1>*4 
I  TYPE  =  3HMIXED 
MXARRY  -  6HMUTWO 

CALL  REACMX(NSFAIC,MWEA0,RANCIN,NF5,T*e,LS,)*fi,  2  ,NID,  ID,  ITYPE, 
1  LRS,MUTV0,M,N,PARM,1RR) 

lF<IRR.hE.O>  GO  TO  6060 
C 

CALL  RDINIT 
ITYPE  =  5HMIXED 
MXARRY  =  €H  C 

CALL  READMX(NSPAIC,M)4IEAD>RANDIN,  NFS,  FHSiLS,  KM5 ,2,  NIB,  ID,  ITYPE, 

1  LRS,  C,  M,N,  FARM,  IRR) 

IF (IRR.M2.0)  CO  TO  6060 
C 

CALL  RDINIT 
ITYPE  =  5HMIXED 
MXARRY  =  6H  W 

CALL  REACMXINSFAIC.M^EAD.RANDIN.M^.I^S.LS.I^^.NID.ID.ITYFE, 

1  LRS,  W,  M,N,  FARM,  IRR) 

IF(IRR.TC.O)  CO  TO  6060 

c 

CALL  RDINIT 
ITYPE  =  3HMIXED 
MXARRY  =  6H  V 

CALL  REACMX(MSFAIC,M)9!EADiRANDIN,  TFS,  FMS.LS ,  THR  ,2,  NI D,  I D,  ITYFE, 

1  LRS.  v,  M,  N,  FARM,  IRR) 

IF(IRR.fC.O)  CO  TO  6060 
C 

CO  TO  25 
000  CONTINUE 
C 

C  THERE  IS  A  COCC  MATRIX  CN  TAPE.  READ  THE  TAPE,  PRINT  MESSAGE, 

C  MAIL  RESUAC  ON  THIS  ONE  AWTWAY . 

C 

C  SET  tSIZ  EQUAL  TO  WOWS  SO  THAT  MATRIX  WILL  NOT  BE  WRITTEN 

C  ON  TAPE 

C 

►eiz  =  mows 
CALL  RDINIT 
Wtt  =  <1-1  >*4 
ITYPE  =  5HMIXED 
MXARRY  =  6HMUTWD 

CALL  READMX(*>PAIC,M>READ,RANDIN,NF5,W4S,L5,AH<,2,  NID, ID, ITYPE, 

1  LRS,MUTWO,M,N,PARM,IRR> 

IF < '  I.AC.O)  CO  TO  6060 
C 

CALL  RDINIT 
ITYPE  =  5HMIXED 
MXARRY  =  6H  C 

CALL  READMX  (NSPAIC ,  MXREA  CiRANCI  N,  NFS,  WAS,  LS,  NMI  ,2,  N!  C.  I D,  ITYPE, 


VICWUN  00152 
VICMIN  00153 
VI CHAIN  00154 
VI CHAIN  00155 
VICHAIN  00156 
VICmiN  00157 
VICHAIN  00158 
VICHAIN  00159 
VICHAIN  00160 
VICHAIN  00161 
VICHAIN  00162 
VICHAIN  00163 
VICHAIN  00164 
VICMAIN  00165 
VICMAIN  00166 
VICMAIN  00167 
VICHAIN  00168 
VICMAIN  00169 
VICHAIN  00170 
VICHAIN  00171 
VICMAIN  00172 
VICMAIN  00173 
VICMAIN  00174 
VICMAIN  00175 
VICMAIN  0C176 
VICHAIN  00177 
VICMAIN  00178 
VICMAIN  00179 
VICMAIN  00180 
VICMAIN  00181 
VICHAIN  00182 
VICMAIN  00183 
VICMAIN  00184 
VICHAIN  00185 
VICMAIN  00186 
VICMAIN  00187 
VICMAIN  00188 
VICMAIN  00189 
VICMAIN  00190 
VICMAIN  00191 
VICMAIN  00192 
VICMAIN  00193 
VICHAIN  00194 
VICMAIN  00195 
VICMAIN  00196 
VICMAIN  00197 
VICHAIN  00198 
VICMAIN  00199 
VICMAIN  00200 
VICMAIN  00201 
VICMAIN  00202 
VICMAIN  00203 
VICMAIN  00204 
VICMAIN  00205 
VICMAIN  00206 
VICMAIN  00207 
VICMAIN  00208 
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i  LRS.C.M.N,  PARM.IRR) 

IF(IRR.NE.O)  CO  TO  6060 
C 

CAUL  RDIN1T 
ITYPE  =  SHMlXED 
MXARRY  =  6H  W 

CALL  READMX<NSPA!C,MWEAD,RA)CIN,)FS,W<S,LS,)M;,2,NID,ID,ITYPE, 
1  LRSiWiHiNi  PARM.IRR) 

IF(IRR.NE.O)  GO  TO  6060 
C 

CALL  ROtNIT 
I  TYPE  =  *KMIX£D 
MXARRY  =  6H  V 

CALL  REACMXINSPAIC.MmEAB.RAMJIN.KFS.ms.LS.mR.a.NID.ID.ITYPe, 

1  LRS.V.M.N,  PARM,  IRR) 

IF(IfiR.NE.O)  GO  TO  6060 
WUTE  (NT6.6005)  l ,  A  ERR  (I) 

CO  TO  25 
10  CONTINUE 
YEAR  a  0.0 
EL  =  0.0 

DETERMINE  THE  SIZE  AM>  LOCATIONS  OF  THE  FLANAR  AIC  ARRAYS. 

C  THE  UN5UBDI VICED  WILL  BE  CALCULATED  FIRST  AND  STORED  IN 

C  THE  JRCPER  PLACE  IN  BLAT*  COMMON. 

C  THE  SUBDIVIDED  WILL  EE  CALCULATED  SECOND,  CMRLAYING  SOME  OF 

C  THE  UNSUB  DIVIDED  NJKiERS. 

C 

C  LSKEKN  =  SIZE  CF  UT6UBDI VI DED  CR  SUBDIVIDED  ARRAY  ALOE. 

C  I  SUB  -  NUK3ER  OF  RCV6  ON  UNSUBDIVIDED  AIC  THAT  SUBDIVIDED 

C  AIC  ARRAY  WILL  OVERLAY 

C  LTCBKN  =  NUMBER  OF  BOXES  OF  UNSUBBIVICEB  AIC  THAT  WILL  BE 

C  OVERLAID 

C  IFKERN  -  SUBSCRIPT  OF  WHERE  FIRST  BOX  OF  UNSUBCIVIDED  BOX 

C  WOULD  BE  IF  IT  WERE  NOT  OVERLAID.  THIS  ALLCV6 

C  PROGRAM  TO  REFERENCE  UNSUC DIVIDED  ARRAY  WITH  FROPER 

C  SUBSCRIPT. 

C  »*XL  =  LENGTH  OF  COMPUTED  AIC  ARRAY 

C 

XNA  =  NPLKRN 

LLKERN  =  (XNA/2.)  *  (XT*  ♦  1.)  ♦  .001 
KXSKRN  =  WLXRN 
1ST  =  0 

IF (NSU6DV.EQ.1)  GO  TO  340 
C 

C  IF  THE  EFFECTIVE  AREA  WAS  INPUT  ON  CAR  DC  USE  THAT 

C  FIND  IF  THE  FLAFFCRM  LIMITS  THE  SIZE  OF  THE  EFFECTIVE  AREA. 

c 

IFimawEA.GT.20)  mCUEA  S  20 
IF(mCWEA.ME.O)  MXSKRN  s  MSUBDV  *  NROWEA 

c 

c 

M50XE3  3  MYBB5W 
MBROW  «  t 

NJCWJW  s  (MYBBSW-1)*2 

500  CONTINUE 

IF  INBOXES  .CT,  LSDW)  GO  TO  325 


VI CHAIN  00209 
VIOttIN  00210 
VICMAIN  00211 
VI CHAIN  00212 
VICMAIN  00213 
VICMAIN  00214 
VICMAIN  00215 
VICMAIN  00216 
VICMAIN  00217 
VICMAIN  00218 
VIOLIN  00219 
VICMAIN  00220 
VICMAIN  00221 
VICMAIN  00222 
VICMAIN  0C223 
VICMAIN  00224 
VICMAIN  00225 
VICMAIN  00226 
VIOWIN  0022 T 
VICMAIN  00228 
VICMAIN  00229 
VICMAIN  00230 
VICMAIN  00231 
VICMAIN  00232 
VICMAIN  00233 
VICMAIN  00234 
VICMAIN  00235 
VICMAIN  00236 
VICMAIN  00237 
VICMAIN  00238 
VICMAIN  00239 
VICMAIN  00240 
VICMAIN  00241 
VICMAIN  00242 
VICMAIN  00243 
VICMAIN  00244 
VICMAIN  00245 
VICMAIN  00246 
VICMAIN  00247 
VICMAIN  00248 
VICMAIN  00249 
VICMAIN  00250 
VICMAIN  00251 
VICMAIN  00252 
VICMAIN  00253 
VICMAIN  00254 
VICMAIN  00255 
VICMAIN  00256 
VICMAIN  00257 
VJCmIN  00258 
VICMAIN  00259 
VICMAIN  00260 
VICMAIN  00261 
VICMAIN  00262 
VICMAIN  00263 
VICMAIN  00264 
VICMAIN  00265 


IT 
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►coxes  =  teoxcs  ♦  teo«w 
mjoww  =  ►eo^w  -  z 
IF<NBO*RW.LE.O>  CO  TO  330 
MSRCW  =  WOW  ♦  Z 
CO  TO  300 
323  CONTINUE 

NSRCJW  s  NSRCW  -  1 

IF  <WCK£S-«0M?U'2  ,GT.  L5CV0  NSRCW  =  NSRCW  -  1 
CO  TO  33$ 

330  CONTINUE 

WOW  =  MXSKRN 
335  CONTINUE 

XNA  =  MXSKRN 

LSKEKN  =  XNA*(XNA/2.)  ♦  (XNA/2.)  ♦  0.001 
I SUB  =  MXSKRM'fCUBDV 

IF  (NSRCW  .LT.  MXSKRN)  I  SUB  =  NSRCWTBUBDV 
SUB  =  I  SUB 

LTCBKN  -  SUB* (SUB/2.)  ♦  (SU6/2.)  ♦  0.001 
1ST  =  LSKERN  -  LTCBKN 
340  CONTINUE 

IFKEKN  =  1ST  ♦  1 
MAXL  =  1ST  *  LUKERN 
IFtmXL.LE.LKERN.)  GO  TO  21 
W5ITE  (NT6.9305)  MAXL.LKERM. 

9305  FORMAT (59HD***  ERROR  -  THE  SIZE  OF  THE  AIC  ARRAY  FCR  THIS  PLANFCRM 
1  IS.I5.29H,  THE  MAXIMUM  SIZE  ALLOWED  IS, 15,  5H.  ***  ) 

CALL  FLUSH  (1 ) 

C 

21  CONTINUE 
C 

IF(NFK  EB.2.AW.NV.ED.NVCS-1)  CO  TO  22 

W  =  1 

NKMS  =  MXSKRN 
CO  TO  23 

22  CONTINUE 
NT  =  IFKERN 
NTOWS  =  NFLKRN 

23  CONTINUE 

DO  24  I=1,M<06 
MIMIC  (1,1)  =  I 
MUAICC2.I)  =1*1-1 

24  CONTINUE 
C 

C 

C  DETER  MI  IC  IF  KERfELS  EXIST  CN  TAPE  ATC  GET  THEM  FRCM  TAPE 

C  IF  PC65IBLE. 

C 

NOT  =  0 

IF(.NCT.OPLAIC)  GO  TO  25 

c 

c  KERNELS  ARE  ON  TAPE.  GET  TABLE  OF  CONTENTS 

REWHt;  NLAIC 
CALI  KiiNIT 

tfS  =  I 

ITYPL  =  5HMJXED 
MXAKRY  =  6HTAB 

CALL  RCACMXCNFLAlC.MXKCAC.RAfCIN.N’S.NNS.LS,  W ,  500.  Nl  D,  ID,  ITYPE, 


VICMAIN  00266 
VICMAIN  00267 
VICHAIN  00268 
VICMAIN  00269 
VICMAIN  00270 
VICMAIN  00271 
VICMAIN  00272 
VICMAIN  00273 
VICMUN  00274 
VICMAIN  00275 
VICMAIN  00276 
VICMAIN  00277 
VICmiN  00278 
VICMA/N  00279 
VICMAI N  00280 
VICMAJ.N  00281 
VI OM IN  00282 
VICMAIN  00283 
VICmiN  00284 
VICmiN  00285 
VICMAIN  00286 
VICmiN  00287 
VICMAIN  00288 
VICMAIN  00289 
VICMAIN  00290 
VICMAIN  00291 
VICMAIN  00292 
VICMAIN  00293 
VICMAIN  00294 
VIOMIN  ,0295 
VICMAIN  00296 
VICmiN  00297 
VICMAIN  00298 
VICMAIN  00299 
VICMAIN  00300 
VICMAIN  00301 
VICMAIN  00302 
VICMAIN  00303 
VICMAIN  00304 
VICMAIN  00305 
VICMAIN  00306 
VICMAIN  00307 
VICMAIN  00308 
VICMA’N  00309 
VICMAIN  00310 
VICMAIN  00311 
VICMAIN  00312 
VICMAIN  00313 
VICMAIN  00314 
VICHAIN  00315 
VICMAIN  00316 
VICMAIN  00317 
VICMAIN  00318 
VICMAIN  00319 
VICMAIN  00320 
VICMAIN  00321 
VICMAIN  0032? 
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2  31X,lHC.34X.lHW.34X,iHV,/3X,2HNU,3X,2HMU,TX,*VELOCITY  POTENTIAL 
3CCEFFICIENT*  10X,*UPWASH  COEFFICIENT*, 15X,*SIBEWA$H  COEFFICIENT*  / 
4  20X.2H-- >,Tx,  32(lH-),2X,32<tH-),2X,32<lH-)  //) 

C 

IF(.NOT.PRNT)  CO  TO  52 

K=0 

KN  =  0 

IF{Nf*.Ea.2.A>C.NV.Ea.NVCS-l)  KN  =  IPKERN  -1 
C 

DO  SO  I=l,NICVe 

N=  1-1 

AH  =  M/2 

43  =  2*<I-1)  *1 

IFCYBAR.fC.O.O)  JS  =  JS+1 

IF(EL.EB.O.O)  JS  =  I 

DO  SO  Jrl.JS 

K=*fl 

KN  =  KM  ♦  1 
N  s  I  -  J 

IF(EL.EB.O.O)  N  =  1-  J 
IFCYBAR.LT .0.0)  N  =  -N 
VRITE  CNT6.9210)  M.N.C(KN)  ,W(K)  ,V(K) 

*10  FCK^AT  (21 5, 5X,  6E1T.8) 

SO  CONTI HJE 
CO  TO  53 
C 

32  CONTINUE 
RN  =  Ki(K 

K  =  RN*  (RW2.)  ♦  (R)V2.)  ♦  t .0E-05 
IFtEL.EB.O.)  CO  TO  53 
K  =  K+K 

IFCYBAR.E8.0.)  K  =  K  -  N5CV6 
53  CONTINUE 


IF  CNSPATK  .EU.  0  .CR.  NY  .CT.  NYCS-NRO  CO  TO  55 
IFCNV.EB.l)  REWIND  IAICSC 

WJITE  THE  SPATIAL  AICS  ON  A  SCRATCH  FILE 

CALL  RDINIT 
FARM  Cl)  =  K1 
FARMC2)  s  XHACH 
FARM  (4)  s  YBAR 
FARM  (5)  =  EL 
I  TYPE  =  SHMIXED 
MURRY  =  6HMUAIC 

CALL  WtTEMX<UICSC,MXH!IT,RAH>OU,trs,He,LS,N4<,LWS,2,lD, 
1  NUAIC.ITYPE.e.mae.FARM.JRR) 

IFCIRR.tC.O)  CO  TO  61  TO 

MURRY  «  «HC 

CALL  W»TtMX<UIC3C,MXHUT,RAtCCU,»r$,H*,U,H«,LW5,2,lD, 
1  C,  I  TYPE.  2.K,  FARM.  IRR) 

IFCIRR.IC.O)  CO  TO  61  TO 

HXARRY  :  3H  U 


VICMAIN 
VI  CHAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VIOUIN 
VIOUIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VIOUIN 
VICMAIN 
VIOUIN 
VICMAIN 
VICMAIN 
VIOUIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
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ANACHI!  VAL)  =  -AMACHdVAL) 

WilTE  <NT6,9Q3Q)  IVAL,  A£RR  UVAL) ,  ISIZE(IVAL)  .NPLKRN 
9030  FCRMATUSHOTHE  PROGRAM  IS  GOING  TO  EN.ARGE  AIC  ARRAY  NO.  13, 

1  29H,  GENERATED  AT  AN  ACCURACY  OF  R8.5  /19H  IT  IS  NECESSARY  TO 

2  29H  EHJIRCE  THE  SAVE!  ARRAY  FROM  13,  3H  TO,  13  ) 

C 

C  SPACE  TO  CORRECT  ARRAY  CN  TAPE 

REWIfC  NPLAIC 
CALL  RCINIT 
=  IVAL-1 
I  TYPE  =  5HMIXED 
KXARRY  =  6H  C 

CALL  REACMX(NRjlIC,M)RREAC,RAfdN,TfS,  f*6,LS,  FHt  ,2,NID,  ID,  I  TYPE, 

1  LRS.CIW).  H,  N,  PAR H,  IRR) 

IF(IRR.tC.O)  CO  TO  €050 
C 

C  SET  HUAIC  ARRAY  FOR  EXPANSION  AIC  CALCULATION 

DO  1  TOO  I=1,ABIZE 
MUAIC  (1 , 1 )  =  0 
MLTAICC2 , 1 )  =  0 
1TD0  CONTINUE 
CO  TO  25 
1800  CONTINUE 
C 

C  THERE  IS  A  COOC  MATRIX  CN  TAPE.  READ  THE  TAPE,  PRINT  MESSAGE, 

C  DO  NOT  MAIL  RESUME. 

C  SET  NSIZE  EQUAL  TO  NPLKRN  SO  THAT  MATRIX  WILL  NOT  BE  WRITTEN 

C  ON  TAPE. 

C 

MIZE  =  NPLKRN 
CALL  RDINIT 
REWIM  W\AIC 
►*6  =  1-1 
I  TYPE  =  5HMIXED 
KXARRY  =  €H  C 

CALL  REACMX<NPLAIC.M*iEAD,RAfClN,NFS,T#6,LS,TM;,2,  NIC,  ID,  ITYFE, 
1  LRS.CIW),  M,  N,  PARK,  IRR) 

IF(IRR.NE.O)  CO  TO  6050 
C 

VRITE  (NT6.e005)  I,  AEKR(I) 

CO  TO  33 
25  CONTINUE 
C 

CALL  KEKKCLIXMACH.Kl , EKR.C INN)  ,W,  V) 

C 

35  CONTINUE 

PR  NT  =  .FALSE. 

IP  (NV.CT.NVCS-NPK)  CO  TO  40 
IF(WiSAIC)  PR  NT  =  .TRUE. 

CO  TO  45 
40  CONTINUE 

IF(PRPAIC)  PR  NT  =  .TRUE. 

45  CONT'NUE 

IF  t .RNT)  VRITE  (NT6.9005)  TITLE, XMACH,K1  ,ERR,ELiYBAR 
9005  FORMAT (1M1,  BAJO,  //  40X,  *A!C  CALCULATICR6*,  /// 

X  17X,  4MACH  =*,  F10.5,  5X,  4KI  =♦, 

1  FtO.T,5X,*ERR  =  *,EI2 . 5.5X,  *EL  =*,  F6.2 , 5X,  4YBAR  =*,FS.2,// 


VICMAIN  00380 
VICMIN  00381 
VICMAIN  00382 
VICMAIN  00383 
VIOMIN  00384 
VICMAIN  00385 
VICMAIN  00386 
VICMAIN  00387 
VICMAIN  00388 
VICMAIN  00389 
VICMAIN  00390 
VICMAIN  00391 
VICMAIN  00392 
VICMAIN  00393 
VICMAIN  00394 
VICMAIN  00395 
VICMAIN  00396 
VICMAIN  00397 
VICMAIN  00398 
VICMIN  00399 
VICMAIN  00400 
VICMAIN  00401 
VI  cm  IN  00402 
VICMAIN  00403 
VICMAIN  00404 
VICMAIN  00405 
VICMAIN  004C6 
VICMAIN  00407 
VICMAIN  00408 
VICMAIN  00409 
VICMAIN  00410 
VICMAIN  00411 
VICMAIN  00412 
VICMAIN  00413 
VICMAIN  00414 
VICMAIN  G0415 
VICMAIN  00416 
VICMAIN  00417 
VICMAIN  00418 
VICMAIN  00419 
VICMAIN  00420 
VICMAIN  00421 
VICMAIN  00422 
VICMAIN  00423 
VICMAIN  00424 
VICMAIN  00425 
VICMAIN  00426 
VICMAIN  00427 
VICMAIN  00428 
VICMAIN  00429 
VICMAIN  00430 
VICMAIN  00431 
VICMA|N  00432 
VICMAIN  00433 
VICMAIN  00434 
VICMAIN  00435 
VICMAIN  00436 
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V  u 


2  31X,1HC,34X.1HW,34X,1HV,/3X,2HNU,3X,2HMU,7X,*VEL0CITY  POTENTIAL 
secern C! ENT*  10X,*uPWASH  COEFFICIENT*,  15X,*SIDEWASH  COEFFICIENT*  / 
4  2(3X,2H—  ),7X,  32<tH->  ,2X,32  (1H-)  ,2X,32(lH->  //) 

C 

IF(.NOT.R5NT)  CO  TO  52 

Rsfl 

XN  =  0 

IF<NfX.Ea.2.ATC.NV.Ell.NVCS-ll  KN  =  IFRERN -1 

c 

DO  50  l=l,N5CWS 
»*:  1-1 
Ml  =  M/2 
J»  =  2*<I-1 )  ♦! 

IFCYBAR.fC.0.0)  JS  =  JS+1 
IF(EL.EB.O.O)  JS  =  I 
DO  50  J=t,JS 
K^*+l 

KM  =  KN  ♦  1 
H  =  I  -  J 

IF(EL.ED.O.O)  N  =  1-  J 
IFOfBAR.LT.O.O)  N  =  -N 
W5ITE  (NT6.9210)  M.N.CCKN)  ,W<K>  ,V(K> 

9210  FaRMAT<2I5,5X,6El7.8) 

50  CONTINUE 
CO  TO  53 
C 

5E  CONTINUE 
RN  =  KtO£ 

K  -  RN*  CRN/2.)  ♦  05W2.)  ♦  1.0E-05 
IFCEL.EB  .0. )  CO  TO  53 

K  =  K+K 

IFCrBAR.EB.O.)  K  =  K  -  N5CMS 
53  CONTINUE 


IF  (NSFATK  .EB.  0  .05.  NV  .CT.  NVCS-NFR)  CO  TO  55 
IF(Ntf.EB.l)  REWIND  IAICSC 

MIITE  THE  SPATIAL  AICS  CN  A  SCRATCH  FILE 

CALL  RDINIT 
FARMC1)  =  K1 
FARM  (2)  s  XMACH 
FARM  (4)  s  YBAR 
FARM  (3)  =  EL 
I  TYPE  s  5HMIXED 
MARRY  =  CHMUAIC 

CALL  W5TEMX<IAICSC,MXM5IT ,RANDOU,  tf3,TM5,LS,  K45  ,LWB,2,  ID, 
I  MMICtITYP€,2,M!  CMS,  FARM,  1RR) 

IF(IRR.NE.O)  CO  TO  6170 

MXARRY  *  «H  C 

«a  W»TtMX<UICSC,MXVRIT,RA5COU,M»,MS,L6,N4!,LVB,2,ID, 
1  C,  l TYPE,  2,K,  FARM,  IRR) 

IFURR.TC.O)  CO  TO  6170 

MXARRY  s  JHW 


VICMAIN 
VI  CHAIN 
VI  CHAIN 
V1CMAIN 
VICMAIN 
VICNAIN 
VICMAIN 
VICHAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICHAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICHAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VIOMIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
vicmiN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICHAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 
VICMAIN 


00437 

00438 

0043S 

00440 

00441 

00442 

00443 

00444 

00445 

00446 

00447 

00448 

00449 

00450 

00451 

00452 

00453 

00454 

00455 

00456 

00457 

00458 

00459 

00460 

00461 

00462 

00463 

00464 

00465 

00466 

00467 

00468 

00469 

00470 

00471 

00472 

00473 

00474 

00475 

00476 

00477 

00478 

00479 

00480 

00481 

00482 

00483 

00484 

00485 

00486 

00487 

00488 

00489 

00490 

00491 

00492 

00493 
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CALL  W<TEMX<IAICSC,MXVRIT,RAPC0U,*ES,We,LS,W«,LW,2.ID, 

1  W,  ITYPE,  2.K.  PARM,  IRR> 

IF<IRR.PE.O>  CO  TO  6173 
C 

KXARRY  =  3H  V 

CALL  W?TEMX(IAICSC,MXVRIT,RAlCCAJ,KFS,f*6,LS,W4t,LV6,2,I0, 

1  V,  ITYPE,  2,K,  PARM,  IRR) 

JF(IRR.IE.O)  CO  TO  6170 
C 

IF<NV.IC.NVCS-NF*i  CO  TO  55 
DC  FILE  IAICSC 
REWIND  IAICSC 
55  CONTINUE 

IFINPLAIC.EB.O.ATC.NSFAIC.EU.OI  CO  TO  1000 

c 

C  TRITE  TOE  KERNEL  CM  TAPE 

IF(W.LE.NVCS-NFK)  CO  TO  900 

c 

C  VRITE  CN  TOE  PLANAR  f.ERNEL  TAPE 

IF<NPLAIC.EB.O>  CO  TO  1000 

c 

C  DETERMINE  IF  A  PREVIOUS  WATR’X  WAS  CN  TAPE. 

C  IF  NKOT  =  0  IT  IS  A  NEW  TAFE  ANC  TO  ERE  ARE  NO  CLD  ONES 

C  IF  N5IZE  IS  LESS  THAN  NR  CVS  A  MATRIX  WAS  EXPANDED  CR  TO  ERE 

C  WAS  NOE  WITH  CCRRESPCNC1  NO  PARAMETERS 

C 

IF(Mcor.EB.O)  CO  TO  60 
IFANSIZE.GE.NRCWS)  COTO1000 

c 

83  CONTINUE 

MAOT  =  NKOT  ♦  1 
AMACHINKOT)  r  XWACH 
AKVAUWCOn  =  K1 
AERR(WCOT)  =  ERR 
ISIZE(NCOT)  =  NRCVS 
REWIND  NPLAIC 
CALL  RDINIT 
WAS  =  NKOr  -  1 
ITYPE  =  5HMIXED 
KXARRY  =  TO  C 

CALL  W?TEMX<NFE>IC,MXW;IT,RANCCU,NES,NMS,LS.NHa,LW5,2,IC, 

I  C (WO  •  ITYPE,  2,  K,  FARM,  IRR) 

IF(IRR.NE.O)  CO  TO  6150 
C 

ETC  FILE  NPLAIC 
CALL  RDINIT 
ITYPE  =  5HMIXED 
KXARRY  =  TOTAB 

CALL  VRTEMXINRJAIC ,  MXVRIT iRANCCAJ,  NES  ,  TOS , LS , NM? , LW5 , 500,  ID, 

I  TAB,  ITYPE,  NA OT ,  3,  PARM,  IRR) 

IF(IRR.AE.O)  CO  TO  6t50 
C 

MXARRY  =  TOISIZE 

CAU  VRTEMX<NPUtC,MXVRIT,RAW>0U,WS,TOS,L3,WR,  LW5.1.ID, 
l  I  SIZE,  l  TYPE ,  1 1 NAOT ,  PARM,  IRR) 

IF(IRR.NE.O)  CO  TO  6150 
DC  FILE  NPLAIC 


VICWAIN  00494 
VI CHAIN  00495 
VICMAIN  00496 
VICMAIN  00497 
VICWAIN  00498 
VICMAIN  00499 
VICMAIN  00500 
VICMAIN  00501 
VICMAIN  00502 
VICMAIN  00503 
VICMAIN  00504 
VICMAIN  00505 
VICWAIN  00506 
VICWAIN  00507 
VICWAIN  00508 
VICWAIN  00509 
VICWAIN  00510 
VICMAIN  00511 
VICWAIN  00512 
VICMAIN  00513 
VICWAIN  00514 
VIOVAIN  00515 
VICMAIN  00516 
VICMAIN  00517 
VICWAIN  00518 
VICWAIN  00519 
VICWAIN  00520 
VICWAIN  00521 
VICWAIN  00522 
VICWAIN  00523 
VICWAIN  00524 
VICWAIN  00525 
VICWAIN  00526 
VICWAIN  00527 
VICWAIN  00528 
VICWAIN  00529 
VICWAIN  00530 
VICWAIN  00531 
VICWAIN  00532 
VICWAIN  00533 
VICMAIN  00534 
VICWAIN  00535 
VICMAIN  00536 
VICMAIN  00537 
VICWAIN  00538 
VICWAIN  00539 
VICWAIN  00540 
VICWAIN  00  541 
VICWAIN  00542 
VICWAIN  00543 
VICWAIN  00  544 
VICMAIN  00545 
VICMAIN  00546 
VICWAIN  00547 
VICMAIN  00  548 
VICMAIN  00549 
VICMAIN  00550 
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DC  FILE  NPLAIC 
OPUUC  =  .TRUE. 

40  TO  1000 
900  CONTINUE 
C 

C  THIS  AREA  WILL  W<!TE  SPATIAL  KERNELS  ON  TAPE 

C  THIS  TAPE  WILL  BE  USED  IN  DOWNWASH  ARC  VELOCITY  POTENTIAL 

C  CALCULATIONS. 

C  IN  THE  DEVELOPMENT  STA4E  IT  WILL  BE  ASCERTAIN  IF  A  TAPE 

C  SHOULD  EE  SAVED  FOR  SUBSEQUENT  RUNS. 

C 

IF(f«PAIC.Ea.O)  40  TO  1000 
IFU*ST.NC.a>  40  TO  910 

c 

C  THERE  WAS  AD  OLD  KERNEL  TAPE  THEREFORE  SKIP  TO  NV-Nf*  AND 

C  ADO  TO  TABLE  CF  CONTENTS. 

C 

HAST  =  NV 
40  TO  920 
910  CONTINUE 
C 

C  IF  N6IZ  IS  LESS  THAN  NROVG  A  MATRIX  WAS  EXPANDED  OR  THERE 

C  WAS  NOE  WITH  CORRESPOND  I  NO  PARAMETERS. 

C 

IF{NSIZ.4E.»RCV6)  40  TO  1000 

c 

C  THERE  WAS  AN  CLD  KERNEL  TAPE  THEREFORE  SKIP  TO  NKST+1  ANC 

C  ADD  TO  TABLE  CF  CONTENTS 

C 

MAST  =  HAST  ♦  1 
geo  CONTINUE 

AMAOH(WAST)  =  XMAOH 
AKVAL(WAST)  =  K1 
AERRANAST)  =  ERR 
YBARS(WAST)  =  YBAR 
\ERTS  (NKST)  =  EL 
ISIZE(WAST)  =  NR  CVS 
REWINC  N6PAIC 
CAU.  RDINIT 
I  TYPE  =  5HMIXED 
WC  =<WAST  -  1)*4 
KXARRY  =  6HHUAIC 

CALL  WlTEHX(N5PAIC,MXW;iT,RANC0U,NFS,N*6,LS.N*R,LW5,Z,ID, 

1  MUAlCt!TYPEi2tNR0WSi  PARM,  IRR) 

IF(IRR.NE.O)  40  TO  6160 
C 

NMS  r  0 

I  TYPE  =  SHMIXED 
KXARRY  s  6H  C 

CALL  W»TEMX<HSPAIC,MXWi!T,RANC0U,NrS.N*«.LS,N#R,LWB,2,!D, 

1  C,  ITYPE.Z.K, PARM, IRR) 

IF(IRR.NC.O)  40  TO  6160 
C 

KXARRY  *  6M  W 

CALL  W?TEMX(NSPAIC,MXWUT,RANCOU,Nrs,We,LS,NM;,LW5,2,ID, 

I  W,  ITYFE.2,K,FARM,IRR> 

IFAIRR.NC.O)  CO  TO  6160 


VI CHAIN  00551 
VICMA1N  00552 
VICmiN  00553 
VZCMAIN  00554 
VICMAIN  00555 
VICNMIN  00556 
VICMAIN  00557 
VICMAIN  00556 
VICMAIN  00359 
VICMAIN  00560 
VICMAIN  00561 
VICMAIN  00562 
VICMAIN  00563 
VICtttlN  00564 
VICMIN  00565 
VIOVAIN  00566 
VICMAIN  00567 
VICMAIN  00566 
VICMAIN  00569 
VICMAIN  00570 
VICMAIN  00571 
VICMAIN  0057L 
VICMAIN  00573 
VICMAIN  00574 
VICMAIN  00575 
VIOMIN  00576 
VICMAIN  00577 
VICMAIN  00578 
VICMAIN  00579 
VICMAIN  00560 
VICMAIN  00581 
VICMAIN  00582 
VICMAIN  00583 
VICMAIN  00584 
VICMAIN  00585 
VICMAIN  00586 
VICMAIN  00587 
VICMAIN  00588 
VICMAIN  00589 
VICMAIN  00590 
VICMAIN  00591 
VICMAIN  00592 
VICMAIN  00593 
VICMAIN  00594 
VICMAIN  00595 
VICMAIN  00596 
VICMIN  00597 
VICMAIN  00593 
VICMAIN  00599 
VICMAIN  00600 
VICMAIN  00601 
VICMAIN  00602 
VICMAIN  00603 
VICMAIN  00604 
VICMAIN  00605 
VICMAIN  00606 
VICMAIN  00607 
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c 

MURRY  =  6H  V 

CALL  WlTEMX(NSPA!C,MXVRIT,RAND0U,)fS,m$,LS,MR,He,2,ID, 

1  V,  I  TYPE,  2,  K,  PARK,  JRR) 

ir<IRR.«.0)  CO  TO  61  eo 
c 

DC  rile  nspaic 

c 

C  WlITE  TABLE  CF  CONTENTS  ARRAYS 

I  TYPE  =  5HMIXED 
MURRY  =  6HTA8 

CALL  VRTENXf^PAlC.MXVRIT.RAfCOU.^S.f+C.LS.^.LVe.SOO.ID, 
1  TAB,  ITYPE,N(ST,3,  FARM,  IRR) 

IP(IRR.>C.O)  CO  TO  6160 
C 

MURRY  =  (HATAB 

CALL  W?TEMX(N5PAIC,MXURIT , RAfCQJ,  NFS,  )XSiLSi  fW*  iLWS,  SCO.  ID. 
1  ATAB,ITYFE,N1ST,3,PARM,IRR) 

IF(IRR.fC.O)  CO  TO  6160 

c 

ETC  PILE  NSFAIC 
DC  FILE  NSPAIC 

IF(NV.EB.MVCS-NFK)  CBPAIC  =  .TRUE. 

1000  CONTINUE 
RETURN 
C 

®10  CONTINUE 

WJITE  (NT6.9010)  ICEOSC.IRR 
WITE  (NT6.901 1 )  MXARRY 
CO  TO  6100 
C 

«0S0  CONTINUE 

VRITE  <NT6,9050)  NFLAIC.IRR 
W5ITE  < NT 6. 901 1 )  MXARRY 
CO  TO  6100 
C 

6060  CONTINUE 

WITE  (NT6.9060)  NSPAIC,  IRR 
MUTE  (NT6.9011)  MXARRY 
CO  TO  6100 
C 

6150  CONTINUE 

VRITE  (NT6.9150)  NPLAIC,  IRR 
W?ITE  (NT6.9151)  MXARRY 
CO  TO  6100 
C 

6160  CONTINUE 

WHTE  (NTS, 9160)  NSPAIC, IRR 
WITE  (NT6.9151)  MXARRY 
CO  TO  6100 
C 

61  TO  CONT  JE 

WdTC  (NT6.9160)  IAICSC.IRR 
MJITE  (MT6.9151)  MXARRY 
C 

6100  CONTINUE 

WUTE  (NT6.9101)  I D <t ) , 1 0(2) 


VI CHAIN  00606 
VI CHAIN  00609 
VICHAIN  00610 
VI CHAIN  00611 
VICHAIN  00612 
VICHAIN  00613 
VICHAIN  00614 
VICHAIN  00615 
VICHAIN  00616 
VICHAIN  00617 
VICHAIN  00618 
VICHAIN  00619 
VICHAIN  00620 
VICHAIN  00621 
VICHAIN  00622 
VICHAIN  00623 
VICHAIN  00624 
VICHAIN  00625 
VICHAIN  00626 
VICHAIN  00627 
VICHAIN  00628 
VICHAIN  00629 
VICHAIN  00630 
VICHAIN  00631 
VICHAIN  00632 
VICHAIN  00633 
VICHAIN  00634 
VICHAIN  006: r> 
VICHAIN  00636 
VICHAIN  00637 
VICHAIN  00638 
VICHAIN  00639 
VICHAIN  00640 
VICHAIN  00641 
VICHAIN  00642 
VICHAIN  00643 
VICHAIN  00644 
VICHAIN  00645 
VICMAIN  00646 
VICHAIN  00647 
VICHAIN  00648 
VICHAIN  00649 
VICMAIN  0G65O 
VICHAIN  00651 
VICMAIN  00652 
VICHAIN  00653 
VICHAIN  00654 
VICHAIN  00655 
VICHAIN  00656 
VICHAIN  00657 
VICHAIN  00658 
VICHAIN  00659 
VICHAIN  00660 
VICHAIN  00661 
VICHAIN  00662 
VICHAIN  00663 
VICHAIN  00664 
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WRITE  (NT6.9102)  PARM.IPARM 
WRITE  (NT6.9103)  NFS.WS 
WRITE  <NT6,9104)  ITYPE.M.N 
WRITE  (NT 6, 9900) 

C 

CALL  FLUSH  <1) 

C 

ADOS  FORMAT <*OAIC  ARRAY  NO.*,  13,*,  GETCRATED  AT  AN  ACCURACY  Cf  *,F6.*, 

1  *  IS  BEING  USEE.  *  ) 

C 

9010  FORMAT (53HO***  ERROR  -  WILE  READING  WE  GECMETRY  SCRATCH  FILE  A1C 
1.  15H,  ERROR  CCCE  =  14, 4H  ***  ) 

9011  FORMAT (5X.31HAN  ATTEMPT  WAS  MACE  TO  READ  WE  A6,0H  MATRIX.//) 

9050  FORMAT (4&C***  ERROR  -  WILE  READING  WE  PLANAR  AIC  FILE  A10, 

1  15H,  ERROR  CCCE  =  I4.4H  ***  ) 

9060  FORMAT <4 W0***  ERROR  -  WILE  READING  WE  SPATIAL  AIC  FILE  A10, 

1  15H,  ERROR  CCCE  =  I4.4H  ***  ) 

9150  FORMAT <4€H0***  ERROR  -  WILE  WRITING  WE  HJANAR  AIC  FILE  AID, 

1  15M,  ERROR  CCCE  =  14, 4H  ***  ) 

9151  FORMAT (5X.32HAN  ATTEMPT  WAS  MADE  TO  WRITE  WE  A6.8H  MATRIX.//) 

91®  FORMAT (47H0***  ERROR  -  WILE  WRITING  WE  SPATIAL  AIC  FILE  A10, 

1  15H,  ERROR  CCCE  =  I4.4H  ***  ) 

C 

9101  FORMAT (5X,*MATR IX  ID  =  *,  A10.  110) 

91 0Z  FORMAT (5X,*PARAMETERS  *,10E11.3,  /10X,*(INTEGCR)*,  IT,  9111  ) 

9103  FORMAT (5X,*FILE  SFACING  =  *,I3,*  MATRIX  SFACING  =  *,I3  ) 

9104  FORMAT  (SX.WATR IX  TYPE  -*,A10,*,  CIME>6IOEE  <*I4,2H  X.I4.1H)  ) 


9900  FORMAT  (40 
ETC 


ERROR  OCCURRED  IN  AIC  SECTION  (VICMAIN).*  ) 


VI CHAIN  00665 
VICMAIN  00666 
VICMAIN  00667 
VICMAIN  00666 
VICMAIN  006® 
VICMAIN  00670 
VICMAIN  00671 
VICMAIN  00672 
VICMAIN  00673 
VICMAIN  00674 
VICMAIN  00675 
VICMAIN  00676 
VICMAIN  00677 
VICMAIN  00678 
VICMAIN  00679 
VICMAIN  00600 
VICMAIN  00661 
VICMAIN  00662 
VICMAIN  00683 
VICMAIN  00664 
VICMAIN  00685 
VICMAIN  00686 
VICMAIN  00667 
VICMAIN  00668 
VICMAIN  00669 
VICMAIN  00690 
VICMAIN  00691 
VICMAIN  00692 
VICMAIN  00603 
VICMAIN  00694 


HI  09 


r 


i 


I 

I 

I 


► 


► 


SUBRCUTIfC  KERNELCXMACH.Kl.ERR,  C,  V,  V  ) 

KERNEL 

00002 

CO*«N /FILES  /  NT5,NT6,INTAPe,IfCS~,NPLAIC.NSPAIC,N0UTP, 

files 

00002 

1  IOUFSP)HQCESCi I VPSCilCEOSCi IWTF$CS IAICSC 

files 

00003 

COMMON  /VICPAR/  VBAR,EL.M?aWB,MUAIC(2,150) 

KERfCL 

00003 

DIMENSION  XIL  (4)  i  IUC  (3) 

KERfCL 

□0004 

DIMENSION  C(i),  W(l),  V<1I 

KERfCL 

00005 

COMPLEX  C,W,V,  CSV.W5V.VSV 

KERfCL 

00006 

DIMENSION  CMtt),  WTM<2) ,  VTM(2) 

KERNEL 

00007 

EBUIVALENCE  (CSV.CTM),  (WSV.VTM) ,  (VSV.VTM) 

KERfCL 

00008 

COMMON  /BESPUN/  XI8<5>,  A<50,5) 

BCSAICB  00001 

REAL  K1.K1BAR 

KERfCL 

00010 

COMPLEX  ZERO 

KERfCL 

0001 1 

DATA  EPS  /  1.0E-4  / 

KERfCL 

00012 

c 

KERfCL 

00013 

c 

XMACH  -  MACH  NUMBER 

KERfCL 

□0014 

c 

K1  -  REDUCED  FREQUENCY 

KERfCL 

□0015 

c 

ERR  -  CONVERGENCE  CRITERIA  (RELATIVE,  NOT  ABSauTE) 

KERfCL 

00016 

c 

C  -  VELOCITY  POTENTIAL  AERODYNAMIC  INFLUENCE  COEFFICIENTS 

KERfCL 

00017 

c 

W  -  UPWASH  AERODYNAMIC  INFLUENCE  COEFFICIENTS 

KERfCL 

00018 

c 

V  -  SI  DEWASH  AERODYNAMIC  INFLUENCE  COEFFICIENTS 

KERNEL 

00019 

c 

KERfCL 

00020 

ZERO  =  (0.  ,0. ) 

KERfCL 

□0021 

TMACH  =  XMACH*WrtCH 

KERNEL 

00022 

K1BAR  =  (K1*TMACH)/ (TMACH  -1.0) 

KERfCL 

00023 

EL2  =  EL*€L 

KERNEL 

00024 

iTor  =  o 

KERNEL 

00025 

NTP  r  0 

KERfCL 

00026 

IFCfBAR.EQ.0.0)  NTP  =  -1 

KERfCL 

oaa? 

doioog  :  -i ,  feews 

KERfCL 

00028 

c 

KERfCL 

00029 

NTP  =  NTP  ♦  2 

AERfCL 

00030 

c 

KERfCL 

00051 

IS  =  ITOT+1 

KERND 

00032 

IF(EL.EB.O.O)  CO  TO  50 

KERNPj. 

00033 

I TOT  =  I  TOT  ♦  NTP 

KERfCL 

00034 

CO  TO  T5 

KERfCL 

00035 

30  CONTINUE 

KERfCL 

00036 

I  TOT  =  I  TOT  ♦  I 

KERfCL 

00037 

c 

KERfCL 

00038 

73  CONTINUE 

KERNEL 

00030 

»F<HUAIC(2,I).EQ.O)  CO  TO  1000 

KERNEL 

0004. 

c 

.vERNEL 

C0041 

c 

DETERMINE  IF  THERE  ARE  A  NT  BOXES  ON  THE  I-TH  ROW  CUT  BY  THE 

KERfCL 

00042 

c 

MACH  HYPER  BOA.  <1=1  IS  THE  FIRST  ROW) 

KERNEL 

00043 

WARU  =  FLOAT <1 )  -  0.5 

KERfCL 

00044 

VBARL  =  VBARU  -  1 .0 

KERNEL 

00045 

It  (ABS(EL)*EPS  .GT.  VBARU)  GO  TO  950 

KERNEL 

00046 

*_OW  =  VBARL 

KERfCL 

CO047 

IF  aBS(EL)  .CT.  VBARL)  XLOW  =  ABS(EL) 

KERfCL 

00048 

XIB(l)  =  XLOW 

KERfCL 

00049 

XI K  =  0.25  *  (VBARU- XL CW) 

BCSAICB  0000? 

DO  t')5  J=2 ,5 

BCSAIC. 

,  00003 

XI B  v  .  >  =  XIB(J-I)  ♦  XINC 

KERNEL 

0005? 

105  CONTINUE 

“ERNEL 

COO  33 

DC  106  J=J  ,250 

BCSAICB  00004 

A(J)  =  0.0 

KERNEL 

000  i  . 

106  CCffTINUE 

KERNEL 

000'-. 

B)  10 


o  n 


I  WARN  =  0  KERNEL 

00  108  4=1,5  BCSA1CB 

TAU  s  SORT (XIB (J) *XI B ( J)  -  EL2>  KERNEL 

TAUKM  =  (K1BAR/XMACH)  *  TAU  KERNEL 

XIB  (J)  =  TAUKM  KERNEL 

CALL  RANGE  (TAUKM,  N)  KERNEL 

IF(N.LE.IOO)  GO  TO  tO?  KERNEL 

W5ITE  (NT6.9Q05)  N  KERNEL 

9005  FORMAT <  99H0***  THE  ARGUMENT  FCR  A  BESSEL  FUNCTION  YIELDS  AN  CRCER  KERNEL 
1  GREATER  THAN  100.  CRCER  RECUCED  TO  100.  ***  )  KERNEL 

N  s  100  KERNEL 

IFdWARN.EQ  .1 )  GO  TO  107  KERNEL 

I  WARN  s  1  KERNEL 

107  CONTINUE  KERNEL 

CALL  BESSEL  (TAUKM,  A  <1  ■  J ) ,  N)  KERNEL 

108  CONTINUE  KERNEL 

C  KERNEL 

C  THERE  ARE  BOXES  CN  THIS  ROW.  FIND  LEFT  MOST  BOX  AND  PROCEED  KERNEL 

c  from  left  tori orr.  kernel 

U.EFT  =  SORT  (VBARU*V8ARU  -  EL2)  KERNEL 

URICHTs  -ULEFT  KERNEL 

IHALF  =  (NT  P+1 1/2  KERNEL 

REM  =  ABSOfBAR)  -  0.5  KERNEL 

IL  s  ULEFT  -  REM  KERNEL 

IL  sIHALF  -IL  KERNEL 

IR  =  REM  -  URIGHT  ♦  1.0  KERNEL 

IR  s  IHALF  ♦  IR  KERNEL 

IFdL.LT. MIMIC (1,1))  GO  TO  110  KERNEL 

KERNEL 

HYPERBOLA  IS  LESS  THAN  ALLOWED,  REDUCE  LIMITS.  KERNEL 

MJAIC(l.I)  =  IL  KERNEL 

CO  TO  120  KERNEL 

C  KERNEL 

C  HYPERBOLA  CROSSED  A  BOUNDARY,  REDUCE  CALCULATIONS.  KERNEL 

110  It  =  MUAIC(l.I)  KERNEL 

120  CONTINUE  KERNEL 

C  KERNEL 

C  TEST  RIGHT  SIDE  KERNEL 

IF(IR.GT.HLMIC(2, 1 ) )  GO  TO  130  KERNEL 

C  KERNEL 

C  HYPERBOLA  IS  LESS  THAN  ALLOWED,  REDUCE  LIMITS.  KERNEL 

MMIC(2,I1  =  IR  KERNEL 

CO  TO  140  KERNEL 

C  KERNEL 

C  HYPERBOLA  CROSSES  A  BOUNCARY ,  REDUCE  CALCULATIONS.  KERNEL 

130  IR  *  MUAICtt.I)  KERNEL 

140  CONTINUE  KERNEL 

C  KERNEL 

C  DETERMINE  INTEGRALS  FCR  BOXES  IL  TO  IR.  KERNEL 

IF  (IL  .GT.  IR)  GO  TO  950  KERNEL 

DO  900  ID=lL.Ift  KERNEL 

U  *  IHALF  -  ID  KERNEL 

IU  «  U  KERNEL 

ULEFT  t  U  ♦  0.5  ♦  ABS(YBAR)  KERNEL 

(MIGHT:  ULEFT  -1.0  KERNEL 

YMUBAfi  =  ULCF7  -  0.5  KERNEL 

C  KERNCU 

Bill 


00057 

00005 

00059 

00060 

00061 

00062 

00063 

00064 

00065 

00066 

00067 

00068 

00060 

00070 

00071 

00072 

00073 

00074 

00075 

00076 

00077 

00078 

00079 

00080 

00081 

00082 

00083 

00084 

00085 

00086 

00007 

00088 

00089 

00090 

00091 

00092 

00093 

00094 

00095 

00096 

00097 

00098 

00099 

00100 

00101 

00102 

00103 

00104 

00105 

00106 

00107 

00108 

00109 

00110 

00111 

00112 

oom 


CBARL  =  SORT(ULEFT*U.EFT  ♦  EL2) 

KERNEL 

00114 

CBARR  =  SaRT<URICHT*RICHUEL2) 

KERNEL 

00115 

c 

KERNEL 

00116 

IF(CBARL.Lt. VBARL. ANC. CBARR. LE. VBARU  GO  TO  500 

KERNEL 

00117 

c 

KERNEL 

00118 

IF(IU)  300.400,200 

KERNEL 

00119 

c 

KERNEL 

00120 

c 

BOK  IS  TO  WE  LEFT  OF  WE  C.  .ER  LINE  CR  APEX 

KERNEL 

00121 

200  CONTINUE 

KERNEL 

00122 

IF(CBARL.LT. VBARU)  CO  TO  220 

KERNEL 

00123 

c 

KERNEL 

00124 

c 

EDGE  BOK,  OLY  HAS  OC  SECHENT  TO  INTEGRATE 

KERNEL 

00125 

HINT  2  1 

KERNEL 

00126 

XILU)  2  CBARR 

KERNEL 

00127 

XXL<2)  =  VBARU 

KERNEL 

00128 

IUC<1)  2  1 

KERNEL 

00129 

CO  TO  TOO 

KERNEL 

00130 

c 

KERNEL 

00131 

c 

DOUBLY  CUT  BOK,  HAS  TV©  SEGMENTS  TO  INTEGRATE 

KERNEL 

00132 

220  HINT  =  2 

KERNEL 

00133 

XIL(l)  2  VBARL 

KERNEL 

00134 

IF  (CBARR.  CT.VBARL)  XILU)  =  CBARR 

KERNEL 

00135 

AIL (2)  2  CBARL 

KERNEL 

00136 

XILO)  r  VBARU 

KERNEL 

00137 

IUC(l)  21 

KERNEL 

00138 

IUC(2)  =0 

KERNEL 

00139 

CO  TO  TOO 

KERNEL 

00140 

c 

KERNEL 

00141 

c 

BOK  IS  ON  WE  RIGHT  CF  WE  CENTER  LUC  CR  APEX 

KERNEL 

00142 

300  CONTINUE 

KERNEL 

00143 

IF  (CBARR.  LT.  VBARU)  CO  TO  320 

KERNEL 

00144 

c 

KERNEL 

00145 

c 

EDGE  BOK,  HAS  OLY  OC  SEGMENT 

KERNEL 

00146 

t€NT  =  1 

KERNEL 

00147 

XIL(l)  r  CBARL 

KERNEL 

00148 

XIL12)  2  VBARU 

KERNEL 

00149 

IUCU)  r  2 

KERNEL 

00150 

CO  TO  TOO 

KERNEL 

00151 

c 

KERNEL 

00152 

c 

DOUBLY  CUT  BOK,  HAS  TWO  SEGMENTS 

KERNEL 

00153 

320  MINT  r  2 

KERNEL 

00154 

XILU)  2  VBARL 

KERNEL 

00155 

IF(CBARL. CT.VBARL)  XlL(l)  2  CBARL 

KERNEL 

00156 

XIL(2)  2  CBARR 

KERNEL 

00157 

XILO)  2  VBARU 

KERNEL 

00158 

IUCU)  2  2 

KERNEL 

00159 

IUCC2)  2  0 

KERNEL 

001 S) 

CO  TO  TOO 

KERNEL 

00161 

c 

KERNEL 

00162 

c 

CENTER  LUC  CR  APEX  BOX 

KERNEL 

00163 

400  CONTINUE 

KERNEL 

00164 

!F(ABS(EL).LT. VBARL)  CO  TO  473 

KERNEL 

00165 

IF(CBARL. LT.VBARU.CR.CBARR.lt. VBARU)  CO  TO  420 

KERNEL 

00166 

c 

KERNEL 

00167 

c 

CH.Y  BOK  ON  ROW,  CN.Y  ONE  SEGMENT  TO  INTEGRATE 

KERNEL 

00168 

HINT  =  t 

KERNEL 

00169 

XILU)  =  ABS(EL) 

KERNEL 

00)70 

r>  n 


t 


XI  l  12 ;  =  VBARU 

I  uctn  =  3 

CO  TO  Too 
420  C0NT1NX 

IFtCBARL.LT. VBARU. ANC. CBARR. LT. VBARU)  GO  TO  440 

ONLY  HAS  2  SEGMENTS 
MINT  =  2 
XILtl)  =  ABS<EU 
XIL  (2)  =  CBARR 
XXL  (3)  =  VBARU 
IUCtl)=3 
10Ct2)=l 
CO  TO  TOO 


440  CONTINUE 

UK.ESS  THE  HYPERBOLA  CENTER  IS  CN  A  BOX  SIDE  LUC. 
I.E.  YBAR  =  0.5,  THEN  THERE  WILL  BE  2  SEGMENTS. 

IFtABStYBAR)  .NC.0.0)  GO  TO  445 
XILtl)  =  ABS(EL) 

XILC2)  s  CBARL 
XIL  (3)  =  VBARU 
IUC(l)  =  1 
IUC(2)  s  0 
MNT  =  2 
CO  TO  700 
C 

445  CONTI  NX 

C  WILL  HAVE  DC  EE  SEGMENTS  IF  YBAR  .1C.  ZERO 

XILtl)  =  ABStEL) 

XILt2)  =  CBARR 
!UCtl)3  3 

IFtABStYBAR)  .NC.0.0)  GO  TO  450 
C 

c  TWO  segments 

MNT  3  2 
XILt3)  3  VBARU 
IUC  (2)  =0 
CO  TO  TOO 

c 

c  THREE  SEGMENTS 

490  MINT  3  3 

XILt3)  s  CBARL 

IUCt2)st 
XIL  14)  s  VBARU 
IUCt3)=0 
CO  TO  TOO 

C  CENTER  LINE  BOX.  BUT  NOT  APEX,  HAS  THREE  SEGACNTS 

4TJ  CONTINUE 

I F  tCB ARR .  LE .  VB ARL )  CO  TO  220 
WHT  3 
XILtl)  =  VBARl. 

XIL (2)  3  CBARR 


KERNEL  001 T1 
KERNEL  001 T2 
KERNEL  001 T3 
KERNEL  001 T4 
KERNEL  001’5 
KERNEL  00176 

kernel  001  tt 

KERNEL  00178 
KERNEL  00179 
KERNEL  00180 

kernel  00181 

KERNEL  00182 
KERNEL  00183 
KERNEL  00184 
KER)€L  00185 
KERNEL  00186 
KERNEL  00187 
KERNEL  00188 
KERNEL  00189 
KERNEL  00190 
KERNEL  00191 
KERNEL  00192 
KERNEL  00193 
KERNEL  00194 
KERNEL  00195 
KERNEL  00196 
KERNEL  00197 
KERNEL  00198 
KERNEL  00199 
KERNEL  00200 
KERNEL  00201 
KERNEL  00202 
KERNEL  00203 
KERNEL  00204 
KERNEL  00205 
KERNEL  00206 
KERNEL  00207 
KERNEL  00208 
KERNEL  00209 
KERNEL  00210 
KERNEL  00211 
KERNEL  00212 
KERNEL  00213 
KERNEL  00214 
KERNEL  00215 
KERNEL  00216 
KERNEL  00217 
KERNEL  00216 
KERNEL  00219 
KERNEL  00220 
KERNEL  00221 
KERNEL  00222 
KERNEL  00223 
KERNEL  00224 
KERNEL  00225 
KERNEL  00226 
KERNEL  00227 
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XU.  (3)  =  CBARL 
XIL<4>  =  VBARU 
IUC<1>  =  3 
!UC(2)  =  1 
IUC  (3)  =  0 
CO  TO  TOO 

c 

C  FULL  BOX,  ONLY  ONE  SEWCNT  TO  INTEGRATE 

300  CONTINUE 
MINT  =  1 
XIL(l)  =  VBARL 
XIL<2)  =  VBARU 
IUC(l)  =  0 
C 

C  UNITS  AM)  TYPES  FCR  ALL  SEGMENTS  ARE  COMPLETED.  INTEGRATE. 

TOO  CONTINUE 
IDX  =  ID 

IF(EL.ED.O.O)  IDX  =  ID  -  I  ♦  1 
IX  =  IS  ♦  IDX  -  1 
IF<C«X)  .NE.O)  GO  TO  900 
DO  900  INTrl.NINT 
CSV  =  CO.,0.) 

U6V  r  t0.,0.) 

vsv  =  aj.,o.) 

IFLAGcO 

C 

C  CALL  ROC  ERG  INTEGRATION  FCR  REAL  FART 

CALL  ROCEKIXILIINT)  ,XIL(INT+1)  ,  lUC(INT)  ■  £KR,IFLAGIK1BAR,YNM3AR, 
I  ELiXNACHiCTM(I)  ,WTM(1)  ,VTN(1)  ) 

IF(K1  .EB.O.O)  CO  TO  TSO 
I  FLAG  =  1 
C 

C  CALL  ROC  ERG  INTEGRATION  FOR  IMAGINARY  PART 

CALL  ROC0R<XIL(INT>,XIL(INT+1),IUC(INT),ERR,IFUG,K1BAR,YMUBAR, 
1  EL,XMACH,CTM(2)  ,WTM(2) ,  VTM(2)  ) 

730  CONTINUE 

C<IX)  =  C(IX)  ♦  CSV 
W(IX)  =  W(IX)  ♦  W5V 
V(IX)  =  V(IX)  ♦  vsv 

800  CONTINUE 

c 

900  CONTINUE 
CO  TO  1000 
C 

950  CONTINUE 

MIMIC  (1,1)  =  0 
MUAIC  (2, 1 )  =  0 
C 

1000  CONTINUE 
RETURN 
DC 


KERNEL  00228 
KERNEL  00229 
KERNEL  00230 
KERNEL  00231 
KERNEL  00232 
KERNEL  00233 
KERNEL  00234 
KERNEL  00235 
KERNEL  00236 
KERNEL  00237 
KERNEL  00238 
KERNEL  00239 
KERNEL  00240 
KERNEL  00241 
KERNEL  00242 
KERNEL  00243 
KERNEL  00244 
KERNEL  00245 
KERNEL  00246 
KERNEL  00247 
KERNEL  00248 
KERNEL  00249 
KERNEL  00250 
KERNEL  00251 
KERNEL  00252 
KERNEL  00253 
KERNEL  00254 
KERNEL  00255 
KERNEL  00256 
KERNEL  00257 
KERNEL  00258 
KERNEL  00259 
KERNEL  00260 
KERNEL  00261 
KERNEL  00262 
KERNEL  00263 
KERNEL  00264 
KERNEL  00265 
KERNEL  00266 
KERNEL  00267 
KERNEL  00268 
KERNEL  00269 
KERNEL  00270 
KERNEL  00271 
KERNEL  00272 
KERNEL  00273 
KERNEL  00274 
KERNEL  00275 
KERNEL  00276 
KERNEL  00277 
KERNEL  00278 
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SUBROUTINE  ROGER (XILL.XIlU.IUC.ERR, IFLAG.K1BAR .YMUBAR , EL  ,XMACH, 
1  C,  W,  V  ) 

DIMENSION  XI  (512)  ,  FXIC  (512)  ,FXIW(512)  ,FXIV(512) 

DIMENSION  A  (11  ill)  i  AWCll.ll).  AV(11,11),  VT(2) 

REAL  R1BAR 

PIE  =  3.141592654 
C 

C  XI U.  -  XI  LOWER  LIMIT  OF  INTEGRATION 

C  XI LU  -  XI  UPPER  LIMIT  CF  INTEGRATION 

C  IUC  FLAG  IfCICATINO  TYPE  CF  BOX  OR  EDGE  CONDITION  OF 

C  INTERVAL  TO  BE  INTEGRATED. 

C  IUC  =  0,  FULL  BOX 

C  =1,  LEFT  SIDE  OF  INTERVAL  IS  EDGE  OF  MACH  HYP. 

C  =2,  RIGHT  SIDE  CF  INTERVAL  IS  EDGE  CF  MACH  HYP. 

C  =3,  BOTH  SIDES  CF  INTERVAL  IS  EDGE  CF  MACH  HYP. 

C  ERR  -  CONVERGENCE  TEST  CRITERIA 

C  I  FLAG  -  INDICATOR  CF  REAL  CR  IMAGINARY  FARTS 

C  I  FLAG  =  0,  REAL  PART 

C  si,  IMAGINARY  PART 

C  K1BAR  -  FUNCTION  OF  REDUCED  FREQUENCE ,  MACH  NLUGER 

C  YMUBAR  -  COORDINATE  HORIZONTALLY  OF  PULSE  SENDING  BOX 

C  EL  DISTANCE  OF  RECEIVING  BOX  ABOVE  SENDING  PLANE 

C  XNACH  -  MACH  NOGER 

C  ^  -  C  COEFFICIENT 

C  V  -  V  COEFFICIENT 

C  W  -  W  COEFFICIENT 

C 
C 

C  'CALCULATE  INITIAL  VALUES  AT  EJC  POINTS 

C 

EL2  -  EL4GL 

VK  =  -WACH/  (PIEMC1BAR) 

XI  (II  =  XI LL 
XI  (2)  =  XILU 

CALL  FUNCT(2i  XI  , FXIC,  r  XIW,  IFLAG.KIBAR ,EL  .YMUBAR  ,  IUC,  XMACH.BESSW) 
IF(EL.EB.O.O)  GO  TO  101 
lFOdBAR.Ea.0.0)  GO  TO  101 
IFdUC.EB.3)  GO  TO  101 

CALL  VFUNC  (2,  XI  ,FXIV,  I  FLAG, K1BAR, EL,  YMUBAR ,  IUC ,  XMACH,  1 ,  VT> 

101  CONTINUE 

TER  Ml  =  FX!C(1)/XI  (1) 

TER  M2  =  FXIC  (2) /XI  (2) 

MINT  =  Q.5*(XILO-XJLL) 

TC  =  HINT  *(FXIC  (1 ) ♦FXIC  (2) ) 

TW  =  HINT  *(FXIW(1  )+FXIW(2) ) 

A(l.l)  =  TC 
AW(l.l)  =  TV 
IFlEL.ta.O.O)  CO  TO  102 
IF (K1  BAR  .GO  .0.0)  GO  TO  102 
iruuc.Ea.3)  co  to  102 
TV  *  HINT  *(FXIV(1  )+FXJ  V(2) ) 

A  V  (1  , 1  >  *  TV 

102  CONTINUE 
C 

DO  30  N=2.tt 
H  -  (*UU  -  XJLD/l 
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C  RCK3ER 

C  DETERMDC  XI  LOCATIONS  TO  EVALUATE  FUNCTION  AT  ROC  EH 

00  3  4=2, 1, 2  ROCER 

44  =  4/2  ROCER 

XI  (44)  =  KILL  ♦  (4-1HH  ROCER 

3  CONTINUE:  ROCER 

CALL  FVJNCT (4 4, XI ,  FXIC,  FXIW,  I  FLAG,K1BAR ,  EL  .YMUBAR.IUC.XMACH.DUMMT)  ROCER 

iriEL.Ea.o.O)  co  to  103  rocer 

IFOUBAR.EB.O.O)  CO  TO  103  ROCER 

IFUUC.EB.S)  CO  TO  103  ROCER 

CALL  VFUNC  <44, XI ,FXIV, IFU&.K1BAR , EL, YML8AR,IUC,XMACH,0, DUMMY)  ROCER 

103  CONTINUE  ROCER 

C  ROCER 

C  DETER  HIKE  TRAPEZOIDAL  AREA  WITH  THE  NEW  FUNCTION  EVALUATIONS  ROCER 

YMNC  =  0.0  ROCER 

TWM  =  0.0  ROCER 

TMNV  =  0.C  ROCER 

DO  5  4=1.44  ROCER 

T)NC  =  THNC  ♦  FXIC(4)  ROCER 

T»*M  =  TMNU  ♦  FXIW(4)  ROCER 

IF(EL.EB.O.O)  CO  TO  5  ROCER 

IFCKIBAR.EQ.O.O)  CO  TO  5  ROCER 

IF(IUC.»C.3)THNV  =  TWV  ♦  FXIV(J)  ROCER 

5  CONTINUE  ROCER 

TC  =  0.5*TC  ♦  H4TMNC  ROCER 

TW  =  0.5*TW  ♦  H+THNW  ROCER 

ROCER 

PUT  THE  TCW  AREAS  INTO  THE  ARRAY  AND  PERFORM  EXTRAPOLATION  ROCER 

A(M,1)  =  TC  ROCER 

AW(M,1)=  TW  ROCER 

IF(EL.EB.O.O)  CO  TO  104  ROCER 

IFWlBAR.Ea.O.O)  CO  TO  104  ROCER 

IFUUC.EB.S)  CO  TO  104  ROCER 

TV  =  0.S4TV  ♦  H4TMNV  ROCER 

AV(M.l)  =  TV  ROCER 

104  CONTINUE  ROCER 

DO  10  5*=2. M  ROCER 

A(M.N)  =  ((44*(N-1))*A(M,N-1)-A(M-1,N-1))/(«**(N-1)-1)  ROCER 

AW(M.N)=  <(4**(N-t))*AW(M,N-l)-AW(M-l,N-l))/(4*4(N-l)-l)  ROCER 

IFCEL.EQ.0.0)  CO  TO  10  ROCER 

IF(MBAR.EB.O.O)  CO  TO  10  ROCER 

IF(IUC.E8.3)  CO  TO  10  ROCER 

AV(M,N)=  (<4**<N-1))*AV(M,N-1)-AV(M-1,N-1))/(444(N-1)-1)  ROCER 

10  CONTINUE  ROCER 

C  ROCER 

C  DETERMINE  IF  THE  TECHNIQUE  HAS  REACHED  SUFFICIENT  CONVERGENCE  ROCER 

C  =  A(M.M)  ROCER 

W  =  AW(M,M)  ROCER 

IF (EL.EQ.0.0)  CO  TO  105  ROCER 

IFOUBAR.EQ.O.O)  CO  TO  105  ROCER 

IF(IUC.Ca.3>  CO  TO  105  ROCER 

V  c  AV(M.M)  ROCER 

105  CONTINUE  ROCER 

REAR  =  ABS  (ERR*C)  ROCER 

mi  =  M-t  ROCER 

UCIF  =  ABS  (A  (M, MM1 ) -  A  (MM1 , MMI ) )  ROCER 

RDIF  :  ABS (A (M,M)  -A (M  ,MM1)>  RCHDER 


00059 

00060 

00061 

00062 

00063 

00064 

00065 

00066 

00067 

00068 

00069 

00070 

00071 

00072 

00073 

00074 

00075 

00076 

00077 

00078 

00079 

00080 

00081 

00082 

00083 

00084 

00085 

00086 

00087 

00088 
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DELS  =  0.3*<UC!f>RCIF) 

IF(DELS.GT.RERR)  CO  TO  30 
C 

C  C  MAS  CONVERGED,  TEST  FOR  W  CONVERGENCE 

IF  (EL. EG  .0 .0)  GO  TO  50 
RERR  =  ABS(ERR*W) 

UCIF  =  ABS  (AW(M,  144 )  -  AW0441  ,t44>> 

RDIF  =  ABSUW(M.H)  -  AW(M  ,K*41) ) 

DELS  =  0.5  *(UDIF  ♦  RDIF) 

IF(DELS,GT.RERR>  GO  TO  30 
C 

C  CAM)  W  HAVE  CONVERGED,  TEST  FCR  V  CONVERGENCE 

C 

IFOUBAR.EB.O.O  .CR.  IUC.EQ.3)  GO  TO  SO 
RERR  =  ABS(ERRXV) 

(xi f  =  ABSuvtM.mn  -  Avo+ti  ,ms.) ) 

RDIF  =  ABSCAV(MiM)  -  A V (KM  ,  1441 ) ) 

DELS  =  0.5  *(UDIF  ♦  RDIF) 

.IF(CELS.LE.RERR)  GO  TO  50 

c 

C  HAS  NOT  CONVERGED  HAKE  ANOTHER  LOOP. 

30  CONTINUE 
SO  CONTINUE 
C  =  -C/PIE 

IF(EL  .eb.o.o;  GO  TO  TO 
W  =  (EL/PIE)*(W*-TERKG-TERKfl  ♦  BESSW  ) 
IFOUBAR.EB.O.O)  GO  TO  65 
IFCIUC.EB.3)  GO  TO  TO 

V  s  VK*(V  ♦VT(2)-VT(1)) 

CO  TO  TO 

68  CONTINUE 

ETAL  =  YMUBAR  -  0.5 

IFUUC.EB.2)  ETAL  =  -  SQRTIXILEHXILU  -  EL2) 

ETAU  =  YHUBAR  ♦  0.3 

IF(IUC.EB.l)  ETAU  =  SORT(XILU*XIlU  -  EL2) 

XILU2  r  XILU  *  XILU 
XILL2  s  XI LL  *  XI LL 
ETAIC  s  ETAU  *  ETAU 
CTAL2  =  ETAL  *  ETAL 
SU  =  ETAUK  ♦  EL2 
8L  s  ETAL2  ♦  EL2 
St  *  xitue  -  SU 

52  =  XILUe  -  SL 

53  S  XILL2  -  SU 
84  =  XILU?  -  SL 

VI  x  0.0 

ve  ■  o.o 

V3  =  0.0 

v*  =  o.o 

IF(Sl.GT.O.O)  VI  3  ALOC( (XILO+SGRT (SI ) )/SBRT (SU) ) 
IF (S2.GT .0.0)  V2  s  ALCC(  (XILU+SGRT (S2)  (/SORT  (SL) ) 
IF(S3.CT.0.0>  V3  x  AL0C( (XILL»SBRT (S3) )/SBRT (SU) ) 
IF(S4.GT.0.0>  V4  x  ALOG((XILL*SORT(S4)  )/SBRT(SL) ) 
V=  (-1 .0/PIE)  *(V1-V2-V3*V4) 

TO  CONTINUE 
RETURN 
C»« 
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SUBROUTINE  FUNCT<K,XI,FXIC,FXIW,IFUG,MBAR,EL  iVMUBARiIUCi 

funct 

00002 

1 

l  XMACH, BESSY) 

funct 

00003 

DIMENSION  XI  <512)  ,FXIC  (512)  ,FXIW<512)  ,A<50) 

funct 

00004 

c 

funct 

00005 

c 

K  -  NUKSER  OF  FUNCTIONS  TC  EVALUATE 

funct 

00006 

c 

XI  -  VARIABLE  OF  INTEGRATION 

funct 

00007 

c 

FXIC  -  FUNCTIONAL  VAU*!  FCR  C  EQUATION 

funct 

00008 

c 

FXIW  -  FUNCTIONAL  VALUE  FCR  W  EQUATION 

funct 

00009 

c 

I FUG  -  IM3ICATCR  Cf  REAL  CR  IMAGINARY  PARTS 

funct 

UCC10 

c 

I FUG  =  0,  REAL  PART 

funct 

00011 

c 

I FUG  =  1,  IMAGINARY  PART 

funct 

oooir 

c 

XI BAR  -  FUNCTION  OF  REDUCED  FREQUENCY  AM!  MACH  NUWER 

funct 

00013 

c 

EL  -  DISTANCE  OF  RECEIVING  BOX  ABCVE  SEWING  JUNE 

funct 

00014 

c 

YMUBAR  -  COORDINATE  HORIZONTALLY  OF  PULSE  SEWING  BOX 

funct 

00015 

c 

IUC  -  FUG  INDICATING  TYPE  OF  BOX  CR  EDGE  CONDITION  OF 

funct 

00016 

c 

INTERVAL  TO  BE  INTEGRATED. 

funct 

00017 

c 

XMACH  -  MACH  NUWEK 

funct 

00018 

c 

BESSY  -  EVALUATION  OF  EW  POINTS  FCR  W  COEFFICIENTS. 

funct 

00019 

c 

funct 

00020 

REAL  XI BAR 

funct 

00021 

PIE  =  3.141592654 

funct 

00022 

PIE2  =  1.570796327 

funct 

00023 

EL2  =  EL4EL 

funct 

00024 

BESSY  =  0.0 

funct 

00025 

c 

funct 

00026 

DO  1000  1=1  ,X 

funct 

00027 

c 

funct 

00028 

c 

SET  UP  CONSTANTS 

funct 

00029 

TAU  =  SORT (XI  <1)4X1  (I)  -  El_2) 

funct 

00030 

TAUXM  =  <K1  BAR/ XMACH  )*TAU 

funct 

00031 

EPCW  =  XlBAfi*xr<I) 

FUNCT 

00032 

IFOABS<TAU)  .LT.l  .OE-06)  GO  TO  25 

funct 

00033 

THETAU  =  (YMUBAR  ♦  0.5)/TAU 

funct 

00034 

THETAL  =  (YMUBAR -0.5) /TAU 

funct 

00035 

GO  TO  50 

funct 

00036 

w 

CONTINUE 

funct 

00037 

THETAL  =  0.0 

funct 

00038 

THETAU  =0.0 

funct 

00039 

X) 

CONTINUE 

funct 

00040 

c 

funct 

00041 

IF(IFUG.EQ.O)  GO  TO  100 

funct 

00042 

c 

funct 

00043 

c 

IMAGINARY  PART 

funct 

00044 

EXPN  =  -SIN(EPCW) 

funct 

00045 

EXPN4  =  (EP0AAAC06  (EPCW)  -  SIN(EPCW) )/ <XI  (1)4X1  (I)> 

funct 

00046 

GO  TO  200 

funct 

00047 

c 

funct 

00048 

c 

REAL  PART 

funct 

00049 

100 

EXPN  =  COB  (EPCW) 

funct 

00050 

EXPN4  =  (CCS  (EPCW)  ♦  EPCW*S!N<EPCW) )/  (XI  (1)4X1  (I) ) 

funct 

00051 

c 

funct 

00052 

200 

CONTINUE 

funct 

00053 

CALL  BFUNC(TAUKM,A,N> 

funct 

00054 

IF (EL  .EQ.O.O)  GO  TO  250 

funct 

00055 

IF(I.GT.I)  GO  TO  250 

funct 

00056 

IF (IUC.NE.3)  CO  TO  250 

funct 

00057 

CXL  r  ABS (EL)  -  XI  (1) 

funct 

00058 

B 1 1 8 


IFUBS(EXD.6T.1.0E-05)  60  TO  250 
BESSY  =  (EXPN*PIE)/EL 
250  CONTINUE 

BESSO  s  A(l) 

=  0.0 

IFduC.E9.0.<R.I(JC.Ea.2)  60  TO  500 

c 

C  LEFT  SIDE  IS  BOUNDARY  CONDITION 

O  =  P1E2 
60  TO  400 
C 

300  CONTI  MX 

IFUBSOHETAU)  .6E.1 .0)  60  TO  350 
a  =  ASIN(THETAU) 

60  TO  400 
350  CONTI  NX 

a  =  SI6N(PIE2,THETAU) 

C 

400  CONTI  NX 

IF(IUC.LE.I)  60  TO  500 
C 

C  RICHT  SICE  IS  BCWCARY  COBITION 

C2  =  -PIE2 
60  TO  BOO 
C 

300  CONTI  NX 

IF(ABS (THETAL)  -6E.1 .0)  60  TO  550 
C2  =  ASINCIHETAL) 

60  TO  €00 
550  CONTI  NX 

C2  =  SIGN(PIE2,  THETAL) 

€00  CONTI  NX 
C 

lF<IUC.Ea.3)  60  TO  900 
IF  (N  .E8.  1)  60  TO  900 
C 

SI6NX  s  -1.0 
*=  0 

PSI6N  =1.0 
N  =  <NH)/2 
DO  800  IR=2,N 
R  a  R  *1 

P5I6N  =  PSION  *  SI6NX 
PTERM  =  P5I6N/R 

BTERM  =  BTERM  ♦  PTERM*A(IR)*(SIN(2.0M<*C1)  -  SIN(2 .0*RK2) ) 
•00  CONTI  NX 

c 

900  CONTI  NX 

FXIC<I)  «  EXPN  *  (BESSO*  (C1-C2)  ♦  BTERM  ) 

FXtWU)  *  0.0 

IF(DX.Ca.O.O)  60  TO  1000 

FXIW(I)  >  EXPNN* (BESSO* (Cl -C2)  *  BTERM  > 

c 

1000  CONTINX 
RETURN 

c»e 
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FUNCT  00067 
FUNCT  00068 
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c 

c 

c 

c 
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SUBROUTINE  BESSEL <K1 2, A, HO 
DIMENSION  A  (t )  i  AVI150) 

REAL  K12 

K12  -  FUNCTION  OF  XI  VALUE,  MACH  NUACER  A  AC  REDUCED  FREQUENCY 

A  =  EVALUATION  OF  THE  BESSEL  FUNCTION 

NA  -  ORDER  CF  THE  BESSEL  FUNCTION  TO  BE  EVALUATED 

ALHiA  =  l.E-25 
NT  =  NA  ♦  t 
BETA= .0008 

1F0U2-BETA)  76,76,78 
78  CONTINUE 

!F<K12-ALfHA) 76, 76,20 
76  CONTINUE 
(2)  =  0. 

Alt)  =  t. 

CO  TO  99 
20  SUM  =  0. 

6  =  1.5*112  ♦  t. 

AP  =  AVOOOO.NT) 

1  =  AP+11 
AV(I*2)  =  0.0 
AVd+1)  =  ALFHA 

33  AV(I)  =  AVd*l)*I*2./K12*AVd+2) 

IF  <1-1  >  40  ,  40  ,  50 
IF  <MG0d.2)>  60  ,  70  ,  60 
SUM  =  SUM  ♦  AV<I) 

I  =  1-1 
CO  TO  30 
40  C  =  l./C2.*SUMtAVd)) 

I  =  1 

DO  90  II=t.NA,2 
A(I)  =  AV(II)  *  C 
I  =  I  ♦  1 

lFd.Ea.50)  CO  TO  99 
90  CONTINUE 
99  CONTI AAJE 
RETURN 
DC 


BESSEL 

00002 

BESSEL 

00003 

BESSEL 

00004 

BESSEL 

00005 

BESSEL 

00006 

BESSEL 

00007 

BESSEL 

OOG06 

BESSEL 

00009 

BEssa 

00010 

BEssa 

00011 

BEssa 

00012 

BEssa 

00013 

BEssa 

00014 

BEssa 

00015 

BEssa 

00016 

BEssa 

00017 

BEssa 

00018 

BEssa 

00019 

BEssa 

00020 

BEssa 

00021 

BEssa 

00022 

BEssa 

00023 

BEssa 

00024 

BEssa 

00025 

BEssa 

00026 

BEssa 

00027 

BEssa 

00028 

BEssa 

00029 

BEssa 

00030 

BEssa 

00031 

BEssa 

00032 

BEssa 

00033 

BEssa 

00034 

BEssa 

00035 

BEssa 

00036 

BCSAICA  00001 

BEssa 

00037 

BEssa 

00038 

BEssa 

00039 

BEssa 

00040 
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SUBROUTDC  RANGE  (M2.NA) 

RANGE 

00002 

RIAL  K12 

RANGE 

00003 

RANGE 

00004 

CALCULATES  THE  RANGE  ON  THE  VARIABLE  N  FCR  SUBROUTINE  BESSL 

RANGE 

00005 

RANGE 

00006 

RANGE 

00007 

M2  =  FUNCTION  OF  X  VALUE.  HACH  NUKJER  AM!  REDUCED 

RANGE 

00006 

FREQUENCY 

RANGE 

00009 

NA  -  CRDER  OF  THE  BESSEL  FUNCTION  TO  BE  EVALUATED 

RANGE 

00010 

RANGE 

00011 

400  CONTINUE 

RANGE 

00012 

RANGE 

00013 

IF0U2-  0.01)  101.98,96 

RANGE 

00014 

96  IFCK12-  3.00)  102,102,99 

RANGE 

00015 

99  IFOU2-19.00)  103,103,100 

RANGE 

00016 

100  GO  TO  104 

RANGE 

00017 

RANGE 

00018 

101  CONTINUE 

RANGE 

00019 

NA=4 

RANGE 

00020 

RETURN 

RANGE 

00021 

102  CONTINUE 

RANGE 

00022 

MU  3.04*12  *7.0 

RANGE 

00023 

RETURN 

RANGE 

00024 

103  CONTINUE 

RANGE 

00025 

NA=  2.04*112  47.0 

RANGE 

00026 

RETURN 

RANGE 

00027 

104  CONTINUE 

RANGE 

00028 

MU  <10.0/9. >4*12  ♦  29. 

RANGE 

00029 

RETURN 

R1NGE 

00030 

ETC 

«ANGE 

00031 
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sue*  CUT  INC  VFUNCIK,  XI, FXIV.IFLA&.KIBAR,  EL.  YMUBAR,  tUC.XMACH.lND.VT) 

VFUNCT 

00002 

DIMENSION  XI  (256>,FXIV(256),VT(2> 

vfunct 

00003 

REAL  XI  BAR 

VFUNCT 

00004 

c 

VFUNCT 

00005 

c 

INIS  FROCRAM  CALCULATES  THE  FUNCTION  VALUES  OF  INTEGRATION 

VFUNCT 

00006 

c 

FOR  THE  V  COEFFICIENTS. 

VFUNCT 

00007 

c 

VFUNCT 

00008 

c 

K  -  NLM3ER  OF  VALUES  TO  CALCULATE 

VFUNCT 

00009 

c 

XI  -  VARIABLE  ARRAY  AT  VHICH  VALUES  ARE  CALCULATED. 

VFUNCT 

00010 

c 

FXIV  -  FUNCTIONAL  VALUES 

VFUNCT 

00011 

c 

I FLAG  =  FLAG  ITCICATING  REAL  CR  COMPLEX  PART 

VFUNCT 

00012 

c 

IFLAG  =  0,  REAL  PART 

VFUNCT 

00013 

c 

=  1,  I  HA 01  NARY  PART 

VFUNCT 

00014 

c 

XI  BAA  -  FUNCTION  OR  REDUCED  FREQUENCY  AKC  HACH  NUK6EK. 

VFUNCT 

00015 

c 

EL  -  DISTANCE  OF  RECEIVING  BOX  ABOVE  SETCING  FLAKE. 

VFUNCT 

00016 

c 

YMUBAR  -  COORDINATE  HORIZONTALLY  CF  FVA.SE  SENDING  FLAKE. 

VFUNCT 

00017 

c 

IUC  -  flag  IKCICATING  TYPE  CF  BOX  CR  EDGE  CONDITION  CF 

VFUNCT 

00018 

c 

INTERVAL  TO  BE  INTEGRATED. 

vfunct 

00019 

c 

XHACH  -  HACH  NUKEER 

VFUNCT 

00020 

c 

INC  -  IfCICATCR  TO  CALCULATE  VT  TERMS 

VFUNCT 

00021 

c 

=  0,  DO  NOT  CALCULATE 

VFUNCT 

00022 

c 

=  1,  CALCULATE 

VFUNCT 

00023 

c 

VT  -  EXTRA  TERMS  CALCULATE  AT  THE  LIMITS  OF  INTEGRATION 

VFUNCT 

00024 

c 

VFUNCT 

00025 

EPS  =  1.0E-O4 

VFUNCT 

00026 

EL2  =  EL*EL 

VFUNCT 

00027 

DO  500  1=1.  X 

VFUNCT 

00028 

c 

VFUNCT 

00029 

c 

CALCULATE  C OCTANTS 

VFUNCT 

00030 

EPCW  =  K1BAR*XI  (I) 

VFUNCT 

00031 

XI2  =  XI(I)*XId> 

VFUNCT 

00032 

FRESH  =  M  BAR/ XHACH 

VFUNCT 

00033 

YMUP2  =  (YMUBAR  ♦  0.5>*(YMU8AR  ♦  0.5> 

VFUNCT 

00034 

YMUK!  =  (YMUBAR  -  0.5)*(YMU3AR  -  0.5) 

VFUNCT 

00035 

c 

VFUNCT 

00036 

IF(IFLAC.EB.O)  GO  TO  100 

VFUNCT 

00037 

c 

VFUNCT 

00038 

c 

IMAGINARY  PART 

VFUNCT 

00039 

EXPN  =  <EPONC06(EPCW)-SIN<EPCW)  )/XI2 

BCSAICA 

00002 

IF(I)C.EQ.l)  EXPNV  =  -SIN(EPOV) 

BCSAICA 

00003 

CO  TO  200 

VFUNCT 

00042 

c 

VFUNCT 

00043 

c 

REAL  PART 

VFUNCT 

00044 

100 

EXPN  =  (CCS<EPOW)kEPCW*SIN(EFO.-))/XI2 

DCSAICA 

00004 

IF(I»C.Ea.l>  EXPNV  =  CCS(EPOW) 

BCSAKA 

00005 

c 

VFUNCT 

00047 

200 

CONTINUE 

\FUNCT 

00048 

a  =  o.o 

VFUNCT 

00049 

<2  =  0.0 

VFUJCT 

00050 

IFdUC.EQ .1 )  'O  TO  300 

VFUNCT 

00051 

c 

VFUNCT 

00052 

C1R  =  XI2  -  TMUP2  -  EL2 

VFUKCT 

00053 

IF(ABS(C1R) .LT.EPS)  GO  TO  300 

VFUN.T 

00054 

Cl  =  SIN(FSESH*SQ«T(C1R)) 

VFUNCT 

00055 

c 

VFUNT 

00056 

500 

CONTINUE 

VFUNCT 

00G5T 

|F(HX‘.Ce.2!  GO  TO  400 

VFU*)TT 

rove 
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C2R  s  XI2  -  YMU«  -  EL2 
IF(ABS<C2R)  .UT.EPS)  CO  TO  400 
<2  =  »IN(FREQW«SQRT(C2R>> 

400  CONTINUE 

fxivuv  =  expn  *  <ci-c2> 

IFUVC.E9.1)  VT(I)  =  (EXPNV/XIUn  4 
500  CONTINUE 
RETURN 
DC 


VfVJNCT  00059 

vruNCT  oooeo 

VFVJNCT  00061 

vfvjnct  00062 
VFVJNCT  00063 
VFVJNCT  00064 
BCSAICA  00006 

(C1-C2)  BCSJUCA  00007 

VFVJNCT  00067 
VFVJNCT  00068 
VFVJNCT  00069 
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SUBROUTINE  BFUNC (X.AV.N) 


SUBROUTINE  BFUWC  (X,av,N) 

ifvjnc 

00002 

c 

IFUNC 

000C3 

c 

X  -  ARGUMENT  FO  THE  BESSEL  FUNCTION 

IFUNC 

00004 

c 

AV  -  EVALUATION  C F  BESSEL  FUNCTICN 

BFUNC 

00005 

c 

N  -  MAX  0?DW  C f  BESSEL  FUNCTION 

bfunc 

00006 

c 

bfunc 

cscoo? 

«»*«CN  /FILES  /  NTS, NTS, INTAPE. IFTSP.NPLAIC.NSPAIC 

.NOUTP, 

files 

00002 

I OUFSP ,  MCCESC ,  I VPSC ,  I GE06C ,  I WTFSC , 

IAICSC 

files 

00003 

COMMON  /BE5FVPV  XIB (5)  ,  A(50,5> 

BCSAICB  00006 

DIMENSION  AVU) 

IFUNC 

00010 

c 

BFUNC 

0001 1 

c 

n»C  INTERVAL  X  IS  IN 

bfunc 

00012 

IF<*.CC.XIB<1).A»C,X.LE.XIB(5))  GO  TO  50 

BCSAICB  0000? 

EPS  =  1  .OE-04 

BFUNC 

00014 

I  =  1 

BFUNC 

00015 

IF  (ABS(X-XIB<I>)  .LE.  EPSPXIBIin  CO  TO  150 

bfunc 

00016 

1=  5 

BCSAICB  00008 

IF  (ABS  (X-XIBO ) )  .LC.  EPS*XIB<I>)  GO  TO  150 

bfunc 

00018 

W?ITE  (NTS, 9005)  X, XIB <1 ) , XIB (5) 

BCSAICB  00009 

9005  FCKMAT<  68H0***  ERRCR  -  THE  ARGUMENT  FCR  A  BESSEL  FUNCTION  IS  OUT 

bfunc 

00020 

1CF  RANGE.  ***/  14H0 ARGUMENT  =  FH.6/14H  LOWER 

LIMIT  =  Fll.S  / 

bfunc 

00021 

2  I  AH  UPPER  LIMIT  =  Fll.6  ) 

bfunc 

00022 

call  flush  <1 ) 

bfunc 

00023 

90  CONTINUE 

bfunc 

00024 

I  s  2 

bfunc 

00025 

100  IF(X-XIB<I))  200,150,125 

BFUNC 

00026 

125  CONTINUE 

bfunc 

00027 

I  =  I  ♦  1 

bfunc 

00028 

CO  TO  too 

bfunc 

00029 

150  CONTINUE 

bfunc 

00030 

C 

bfunc 

00031 

c 

X  EQUALS  XIB (I)  DO  NOT  INTERPOLATE 

bfunc 

00032 

c 

bfunc 

00033 

N  =  l 

bfunc 

00034 

ISO  CONTINUE 

bfunc 

00035 

AV(N)  =  A(N,I> 

bfunc 

00036 

IF(A<NM,I>.E».0>  GO  TO  400 

BFUNC 

00037 

N  =  N  ♦  1 

bfunc 

00038 

GO  TO  ISO 

bfunc 

00039 

330  CONTINUE 

bfunc 

00040 

DXX  =  (X-XIB(I-1))/(XIB(I)  -XIB(I-D) 

bfunc 

00041 

N  s  1 

bfunc 

00042 

300  CONTINUE 

bfunc 

00043 

AV(N)  z  A (N, 1-1 )  ♦  CXX  A  (A (N, I )  -  A  <N, 1-1 >  > 

bfunc 

00044 

IF  (A  (N*t  ,1-1)  .£0.0.)  GO  TO  400 

bfunc 

00045 

Ns  Nt  I 

bfunc 

00046 

GO  TO  300 

bfunc 

00047 

400  CONTINUE 

bfunc 

00048 

RETURN 

bfunc 

00049 

END 

bfunc 

00050 

B 1 24 


N  *> 


c 

c 

c 

c 

c 

c 

c 


cwerlay  ur^ox.1 ,5) 

PROGRAM  NWVPt«x 

WIS  SECTION  CONTROLS  THE  COMPUTATION  OF  BOX  NCR  HAL  WASH 
VALUES  AM)  VELOCITY  POTENTIAL  DIFFERENCES.  THE  NCR  HAL  WASH 
VALUES  HAY  BE  BUNTED.  BUT  OTHERWISE  ARE  NOT  SAVED.  THE 
VELOCITY  POTENTIAL  DIFFERENCES  ARE  PLACED  ON  SCRATCH  FILE 
IVPSC,  TWO  HA  TRICES  PER  HCCE  SHAPE 

COMCN  FRERH.  (1640) 

COlPLEX  PKERH. 

COM4CN  /CCNTRL/  FREVEX.CMACH,  TITLE (8) .  PRVCECM.PRVMOCE.DIHW.DIHT, 
1  DEFAULT 

LOGICAL  BAVCECH.fRVHCCE.DIHW.DIHT,  DEFAULT 
COWCN  /fRCBLH/  XHAOH,f#CCES,NTSLOP,  NAVALS, SMOOTH, TCEt.CRCFIT, 

I  EXAIC.SUBDV.fVYWOCC 

LOtICAL  SHOOTH.CRCFIT.EXAIC.SUGCV,  B.YWOCC 

COMCN /GEOKTY/  CORjAN.NSUBCV.  XSUCDV,  F6U8D2,  NSUBCN.NSURF, 

1  BI. BIBETA, BIS, BIBTAS.W-AX.WJAZ.PSIW, 

2  MX8W,  HXBBW,  Mf  BW,  MT  BBW,  MXBSW,  Mf  BSW,  MT  BBSW, 

3  I XBW,  XCENTR 
LOtICAL  COPLAN 

OWCN  /CCOC  /  TLAX,TLA2,PSlT,HXBT,AfrBT,AYBBT,HXBST,HTBST, 

1  MYBBST.IX8T,  IXSST.CAFL 

COMON  /  KERN  /  ERR  .MXSXRN,  I FKERN,  NFLKRN,  K6PATK ,  FRCWEA 
OOPPON  /KVAL  /  IKVAL,  1RAVAL (20) ,  WS(20) 

COPPON  /FILES  /  NT5.NT6, INTAPE, IMSP,Na>IC,N5FAIC,N0UTP, 

1  I0UFSP.HCCE5C, IVPSC, ICEC6C, IWTFSC, IAICSC 

COPPON  /IOCCNT/  OPLAIC.OSFAIC.WrGECM.WrCNAF.WTSL.WTBL.PRBOX, 

1  PRPAIC.PRSAIC.WHOCS.PRCCEF.PRDW.fRSW.PRVP, 

2  PRBL.PRDCP.FRCNAF.RRGNAC.PRSL.fRLW.PRFW.FRCH 
BUI  VALENCE  (PRUW.FRCW) 

LOtICAL  OPLAIC.06PAIC,WTCCCN,WrtNAF,WrSL.WTBL,B;BOX,PRPAIC, 

1  PRSAIC,  PRHCCS,  FRCCEF,  PRCW,  BSW.  BVP,  BBL,  PRSL.  BGNAF, 

2  bdcp.bohc.buw.blw.bnw.frch 

OOPPON  /TAPEICy  MS.MPS.LS.FPR.ICiaOl.NID.ITYPE.LRS.LVC.M.N, 
t  PARH<10)  ,  IRR 

DIMENSION  I  PARH(IO) 

BUI  VALENCE  (PARM.IPARM) 

COPPCN  /  MIXES/  SYH.SYMT.MTYPEW.NTYPET 

COPPCN  /ARRAYS/  KBXCCV.LJBXCDW.LBOXC.KBXCDT.LBXCCT.KJALFH.LJALFH, 

1  IUL»HA,KKERH.,LKERM.,KPNTRH,LPNTRH,KDEF5L,KELFHI, 

LHQDES  .KPNTSC,  LPNTSD  ,KSDW,  LSCW,  KPNTDW,  LPNTCW, 
KDW.LDW.KTVP.LTVF 
COMMON  /SAMPLW  ISMPLW,  ICHCRD  (10) ,  IBOXF(IO) ,  IBOXUIO)  ,2L0C  UO) 
COMMON  /PA ICS  /  NULK,  NTTK,  PRWTK,  X.VTK,  PAIC(4,50> 

INTEGER  PAIC 

DIMENSION  >*(4J 

BUI  VALENCE  (NWWA.AK  (I  > ) 

COMMON  /MUAICS/  YBAR,EL,MUAIC<2,S0)  .BOMB, SURF, 

1  YBARL.ELU,  MUAICU (2 , 50)  , NROftt .SURFL , PSI DIF 

LOGICAL.  S'.MF.SURFL 

COPPON  /AICS  /  *VL,  C  (1640)  ,W(tS40)  ,V<1640) 

COMPLEX  C,  W,  V 

CELFHI  (LHXES) ,  T VP(LTVP) ,  TEH.0C (LTVP) 

CCMHCN  /CELTAP/  DELHPl  (1080) ,  TVP(2S0) ,  TEXL0C(250),  FEXLOC  (250)  , 
I  | PNTRMI2 , 100)  , NPNTRS,  IOVLAP 


NWVPP«X  00002 

MWPteX  00003 

MWWCX  00004 

NUNP*©X  00005 

NUNPveX  00006 

NW^FveX  00007 

MWVPt«X  00008 

NW/FYCX  00009 

nwvp*«x  oooio 

MWVP»«X  00011 

NWrfFve  x  00012 

CCNTRL 

00002 

CCNTRL 

□0003 

CCNTRL 

00004 

PRCBLH 

00002 

PRCBLH 

□0003 

PRCBLH 

00004 

CEOHTY 

00002 

tECKTY 

0C003 

CECMTY 

00004 

tECMTY 

00005 

CECMTY 

00006 

otoe 

00002 

ceoc 

□0003 

KERN 

00002 

KVAL 

00002 

FILES 

00002 

FILES 

00003 

IOCCNT 

00002 

IOCCNT 

0000 X 

BCSFRB 

00001 

ICCONT 

00005 

IOCCNT 

00006 

IOCCNT 

00007 

BCSFRB 

00002 

TAPEIO 

00002 

TAPEIO 

00003 

TAPEIO 

00004 

TAPEIO 

00005 

MOOCCM 

00002 

ARRAYS 

00002 

ARRAYS 

00003 

ARRAYS 

OOOC4 

ARRAYS 

00005 

SAMH.W 

00002 

PAICS 

00002 

PA  ICS 

00003 

PAICS 

00004 

PAICS 

00005 

MUAICS 

00002 

MUAICS 

00003 

MUAICS 

00004 

AICS 

00002 

AICS 

00003 

DELTAP 

00002 

DELTAP 

00003 

CELTAP 

00C04 

B125 


c 


c 

c 


c 

c 

c 

c 

c 

c 


c 

c 


c 

c 


c 

c 

c 

c 


COMPLEX  DELPHI ,  TVP 

DEFSL  (2.LMCCES) 

OI»CWION  DEFSL(2,tOOO> 

eaui valence  icami  ($i>.  defslj 

ARRAYS  DELPHI  AND  CEESL  ARE 
E8UI VALENCED  to  cm  a  2  row  UN- overlapped  section 
OITCTCICN  TVPX(500),  XIWTXI2) 

OA.EX  XI NIT 

EQUIVALENCE  (TVP.TVPX)  ,  (XINIT.XINITX) 

COMON  /TRASHES/  IPNTCW(2,100),ETRUS(1275>,  ETRLSU275) ,  IOVLAPT. 
COMPLEX  ETRUS,  ETRLS 

CCH4CN  /SMASH/  IPNTSD(2,5C>,  ENSUED  (2, 600) ,  I PNTIN,  I PNTOT,  I PNTLS 
IPNTSC(LPNTSD) ,  ENSUED  (2M-SCW) 

COMPLEX  ENSUBD 

IBOKW(LBXCCW,LBC*C) ,  THERE  LBOXC  =  LSCHDS/20 
0O#ON  /BXCDES/  IBOXW(150,8) 

IBCKW  IS  USED  FCR  BOTH  WING  AND  TAIL  BOX  COCES 

I PNTRM (2 1  TROWS) .  I  PNTCW(2 ,  TROWS)  .  I PNTSC  (2 .  NSROHS) 

COMMON  /LRCJT  /  LROT 

COCON  /CHECK PR/  DPPCFR , GEOCPR, HCCCPR , AICCB5 ,NUBCFR,SMCPR,GAFCTR 
LOGICAL  CPPCfR,  GEOCPR.  MCCCPR,  AICCPR . MWSCFR ,  SMCFR,  GAFCFR 
LOGICAL  CHECKER 
BDUI VALENCE  (CHECK  PR,  TACCFR) 

DIMETelCN  TITL (3) 

DIMENSION  PARMW(IO)  .IPARMW(IO) 

EQUIVALENCE  (FAR  MW,  I  FAR  MW) 

LOGICAL  MXTRIT,  RATCOJ,  MAC.MXURT 

DATA  TVFX  /  500*  600000G0000200377777B  / 

DATA  KXVR IT, RATCOU,  MXRC.MXVRT  /  .F. , .F. , .F. , .F.  / 


PSICIF  s  PSIT  -  PSIW 
IPNTLS  =  LPNTSD 
LlMCWS  =  LSCW 
LRCX  =  NSUEDV  ♦  NSUBCN 
NTVP  =  (MTBSW  ♦  Mi’BST) 
PAR  MW  (2)  =  B1 

par  taw (3)  =  xmach 

IPARMW(4>  =  T**XES 


DELTAP 

DELTAP 

DELTAP 

DE1.TAP 

DELTAP 

DELTAP 

FTNXt 

ftnxj 

FTNX1 

MASHES 

TRASHES 

SMASH 

SMASH 

SMASH 

BXCDES 

BXCDES 

BXCDES 

NWVFVCX 

NWVPTCX 

NWVPTCX 

NWVPMBX 

CHECKER 

CHECK  FR 

MWVPT  y. 

NWVPTCX 

NWVPTCX 

NWVPTCX 

NW/PTCX 

NWVPTCX 

FTNX1 

NWVPTCX 

FTNX1 

NWVPTCX 

NWVPTCX 

NWVPTCX 

NWVPTCX 

NWVFHBX 

NWVPTCX 

NWVPMBX 

NWVFTCX 

NWVPTCX 

NWVPTCX 

NWVPTCX 

NWVPTCX 


00005 
00006 
00007 
00008 
00009 
00010 
00051 
00052 
00053 
00002 
00003 
00002 
00003 
00004 
00002 
00003 
00004 
00033 
00034 
00035 
00036 
00002 
00003 
00038 
00039 
00040 
00041 
00042 
00043 
00054 
00044 
00055 
00047 
00048 
00049 
0G050 
00051 
00052 
00053 
COO  54 
00055 
OOC56 
00057 
GOO  58 


RCWITC  ICC  CSC 
REWIND  HOC  ESC 
REWIND  IVPSC 

AVL  =  AVAL  (IKVAL) 

READ  GEOCTRIC  I TCCR  NATION 
WING  BOX  CODES 
MXARRY  =  9HBOX  CCCES 
CALL  SCI  NIT 
ITYPE  r  5HMIXED 
K  i  LBXCCW 


NWVPtCX  00059 
NWVPTCX  00060 
NWVOCX  00061 
NWVPTCX  00062 
NWVPTCX  00063 
NWVPTCX  00064 
NWVPTCX  00065 
NWVPTCX  00066 
NWVPMBX  00067 
NWVPTCX  00068 
NWVPMBX  00069 
WWVFMBX  00070 


CALL  RCADMX  (IGEC6C,  MXRD,  .F.,  NFS.NMS.LS,  NTR ,  K ,  NIC, ID,  ITYPE,  NWVFMDX  00071 
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M,N,  PARH,  IRR) 


c 

c 


*  ms,  iboxw, 

IP  (IRR  .NE.  0)  CO  TO  910 

MXBBS  s  M 

IP  (NSU5F  .E9.  1  .CR.  CORjkN)  CO  TO  20 

TAIL  BOA  CCCES 
HXARRY  =  10HTAIL  CCCES 
aLL  RCINIT 
I  TYPE  =  SHMIXED 

CALL  REACH*  UGEOSC,  M«D.  S.  ,  FfS,F*45,LS,  K,  NIC, ID, 
LRS*  IB0AW(HXB3SM,1),  H,N,  PARH,  IRR) 

IP  (IRR  ,f€.  0)  CO  TO  910 
ISl£T  =  MXBES  *  Z  -  IABST 

=  SUBSCRIPT  FCR  IBOAW  TO  CET  TAIL  CCCES 

20  CONTINUE 

HXARRV  10H  FEXLOC 
CALL  RUNIT 
I  TYPE  =  SHMIXED 

CALL  REACMX ( I CECSC ,  MWC..F.,  ^S.^.LS,  NR,  ,, 

I  LRS,  FOLOC.  M,N,  FARM,  IRR) 

IP  (IRR  .Ft.  0)  CO  TO  910 


KXARRY  =10H  TEXLOC 
CALL  RCINIT 
I  TYPE  =  SHMIXED 

CALL  REACMA(ICEC6C,  MARC..F.,  FPS>fW5lLSl  I**,  1, 
t  LRS,  TETQ.OC,  M.N,  FARM,  IRR) 

ip  ora?  ,»c.  o>  co  to  910 
IP(M  ,»C.  1)  CO  TO  930 

IP  (PSIW  ,FC.  0  .AFC.  DIHW)  CO  TO  30 
IP  (ISMPLW  .FC.  0)  CO  TO  30 
IP  (P6URF  .EO.  1)  CO  TO  40 
IP  (CAfL  .NE.  0)  CO  TO  30 
IP  (PSIDIF  .FC.  0)  CO  TO  30 
IP  (PSIT  .FC.  0  .AFC.  CIHT)  Co  TO  30 
CO  TO  40 


NIC, ID,  ITYPE, 


NIC, ID,  I  TYPE 


C 

c 


READ  THE  ARRAY  CP  AlC  TABLE  J  CONTENTS 

®  CONTINUE 

KXARRY  =  9HSPAT.  TOC 
CALL  RCINIT 
*•«  =  2 
X  z  4 

CAU.  READMX  (ICCOSC,  M*D,  .F.,  FCS.FAfi.LS, 
*  LRS,  PAIC,  M,N,  FARM,  IRR  ) 

IP  (IRR  ,FC.  0)  CO  TO  910 
0O3S  I  s  1,4 
*(I>  *  IPARK(I*2) 

33  CONTI  F4JE 
40  CONTINUE 
RCWPC  ICCOSC 

CET  POINTER  ARRAY  FCR  MCCES 
CALL  RCINIT 
ITYPE  r  5HMIXC0 


K,  NIC, ID,  ITYPE, 


*<vF>ex  ooarz 
nwvp»«x  ooo n 
Mwvpvex  00074 

NWVPMBX  00075 
NWVPveX  00076 
NWVPMBX  00077 
NWVP»«y  00078 
MWVPvex  00079 
NWVPFCX  00080 
ITYPE,  NWVPfcx  00081 
NWVPVflX  00082 
NWVPKBX  00083 
NLNPVCX  00084 
NUNPLBX  00085 
NWVPFCX  00086 
NWVPFCX  00087 
NLNPKJX  00088 

NWVF4CX  0008S 
NWVFM3X  00090 
NWVPFCX  00091 
NWVFMJX  00092 
NWVFTCX  00093 
NWVFMSX  00094 
NWVPFCX  00095 
F*NF*®X  00096 
FMVFFCX  00097 
NWVPMBX  00098 
NWVPK1X  00099 
NWVFFCX  00100 
NW/PFBX  0010J 
NWVPMBX  00102 
NWVPMBX  00103 
NWVPFBX  00104 
NWVFM3X  00105 
NWVPFBX  00106 
NWVFH5X  00107 
NWVPFBX  00108 
NWVPFBX  00109 

nuvpfbx  coho 
nwvpfbx  00111 

NWVPFBX  00112 
NWVPFBX  00113 
NWVPMBX  00114 
NWVPMBX  00115 
NWVPFBX  00116 
NWVPFBX  00117 
NWVPmBX  00118 
NWVPMBX  00119 
WWVFY6X  00120 
NWVPMBX  00121 
NWVPMBX  00122 

nwvpfbx  00125 

NWVPFBX  00124 
NWVPMBX  00125 
NWVPmBX  00126 
MWVPmCX  00)21 
NWVPMBX  00128 


B127 


CALL  REACMX(HCCE$C ,  MXRC..F.,  NFS,  IMS,  LS,  N*.  2,  NID.IC,  I  TYPE. 
1  LR3,  IPNTRM,  N,N,  PARM,  IRR) 

IF  (IRR  .RE.  0)  CO  TO  912 
IF  (M  .HE.  2)  CO  TO  931 
WWTRS  =  N 
ICNLAP  =  IPARM<3) 

IOVLAP  =  NUWER  CF  ROWS  TO  ALLOW  FCR  TAIL  OVERLAP  (TAIL  0W.Y) 
NPNTRS  =  TOTAL  NUMBER  CF  ROWS  ON  BOTH  SURFACES,  ♦  1  . 
(INCLUDES  OVERLAP  IF  SPATIAL) 

SET  UP  POINTER  ARRAY  FCR  UNSUBBI VICED  DOWNWASHES 

IP  =  1 

WTBB  =  MYBBW 

IF  (COPLAN)  MTBB  =  MA)®  (MYBB.HTBBT) 

MT  BBS  =  MYBBtNSUBCV 
MXBB  =  MXBBW 
IF  (COPLAN)  MXBB  =  MXBT 

CALL  POINT* <  1  ,MX8B,MYBB,  .F.,  .T.,  IBOXW.LBXCDW,  LPNTCW.l, 

1  ,  IP,  IPNTCW) 

MXB  =  MXBW 

IF  (COPLAN)  MXB  =  MXBT 
MTB  =  MTBW 

IF(COFLAN)  MTB  =  MTBT 
IOVLAPN  =  0 

IF  (NSURF  .EQ.  1  .CR.  COPLAN)  CO  TO  50 
MXB  =  MXBT 

IXBUT  =  (IX8T-IXBW)/N5UBDV  ♦  1 
IP  =  MXBBW  ♦  1 
IPNT  =  IPNTCWd  , IP) 

CALL  POINT*  (IXBUT,  MXBT-I XBUT+1 ,  MTBBT,  .F.,.T.,  I  BOXW<  I SUBT ,  I )  , 

1  LBXCCW.LPNTCW,  IPNT,  IP,  IPNTDW) 

IF  (MXBBW  .CE.  IXBUT)  ICVLAPN  =  MXBBW  -  IXBUT  ♦  1 
30  CONTINUE 

LOOP  ON  WXE  SHAPES 
DO  500  IMCCE  r  1 , RHCCES 

ZERO  OUT  THE  DOWTAWASH  ARC  VELOCITY  POTENTIAL  ARRAYS 
UN  =  IPNTCWd, IP)  -  1 
DO  SO  I  =  l.LIM 
EWUSU)  =  XINIT 
EM!LS(I)  =  XINIT 
SO  CCNTIMJE 

UM  =  IPNTKMd  .NPNTKS)  -  I 
DO  S3  I  =  l.LIM 
DELfftl  (I)  =  (0..0.) 

S3  CONTINUE 


READ  IN  MOCE  SHAPE 
CALL  RDIMIT 

MXARRY  =  10HM0CE  SHAPE 
I  TYPE  =  4HREAL 

CALL  READMX(MCCtSC  i  MWI0..F.,  WS.fW.LS,  N«,  2,  NIC,  ID,  I  TYPE, 
l  LRS,  CEFSL,  M,N,  PARM,  IRR) 

IP  (IRR  .HE,  0)  CO  TO  912 
IF  (M  .TC.  2)  CO  TO  931 


NWVFMBX  00129 
NWVPWX  00130 
NWVPWX  00131 
NWVPWX  00132 
NWVPWX  00133 
NWVPWX  00134 
NWVPWX  00135 
NWVPWX  00136 
NWVPWX  001 37 
NWVPWX  00138 
NWVFWX  00139 
NWVFWX  00140 
NWVPWX  00141 
nwvfwx  00142 
NWVFWX  00143 
NWVFWX  00144 
NWVPWX  00143 
NWVFMBX  00146 
NWVPWX  00147 
NWVFWX  00148 
NWVFMBX  00149 
NWVFWX  00150 
NWVPWX  00151 
NWVFWX  00152 
NWVFWX  00153 
NWVPWX  00154 
NWVPWX  00155 
NWVFWX  00156 
NWVPWX  00157 
NWVFWX  00158 
NWVFWX  00159 
NWVFWX  00160 
NWVPWX  00161 
NWVPWX  00162 
NWVPWX  00163 
NWVPWX  00164 
NWVPWX  00165 
NWVFWX  00166 
NWVPWX  00167 
NWVPWX  00168 
NWVPWX  00169 

nwvfmb.:  ooi7d 

NWVFWX  00171 
NWVPWX  001  .*2 
NWVPWX  00173 
NWVPWX  00174 
NWVPWX  00175 
NWVPWX  00176 
NAWPWX  00177 
NWVPWX  00178 
NWVPWX  00179 
NWVPWX  00180 
NWVPWX  00181 
NWVPWX  00182 
NWVPWX  00183 
NWVFWX  00184 
NWVFWX  00103 


C  COMPUTE  DCWNWASHES  A»C  VELOCITY  POTENTIALS  FCR  ONE  MODE 

CALL  VELPOT  (  IBOXW.LBXCDW,  PKERR.(IR(ERN) ,  R(ERN.,  .T.,  DIHW) 
C  OPTIONAL  PRINT  CP  NORMAL  WASHES 

IP  (  .NOT.  (CHECK PR  .CR.  PRNW)  )  CO  TO  90 

IP  (NSUBDV  .EQ.  1>  CO  TO  87 

IF  (.NOT.  CHECK  PR)  CO  TO  87 

T1TL  (1 )  =  10HEN  SUBDIVl 

T1TL  (2)  =  IOHCEOi  UPPER 

TITL(35  =  10H,  PARTIAL 

IF  (IPNTIN  .LT.  IPNTOT)  CO  TO  88 

CALL  PRINTR(TITL,IMCCE, ENSUED, 2.  1.  IPNTIN-1,  NfBBS. IPNTSC) 

CO  TO  87 
88  CONTINUE 

CALL  PRINTR  (TITL,  IMCCE.ENSUESD, 2,  IPNTOT,  IPNTLS-t.NTBBS.IRffSD) 
CALL  R?tNTR  (TITL,  IHCCE,  ENSUED,  2,  1,  IPNTIN-I,  MYB&S,  IPNTSD) 
87  CONTINUE 

TITL(l)  =  1CHWINC  UPPER 

TITLC2)  =  10H  SURFACE  N 

TITL  (3)  =  10HCRMAL  WASH 

IF  (COPLAN)  TITL(l)  =  10H  WINC/TA 

IF  (COPLAN)  TITL(2)  =  10HIL  UPPER  N 

CALL  PRINTR (  TITL.IMCCE,  ENRUS.l,  l.MXBB.Hl'BB,  IPNTDW) 

IF  <.N.  COPUN)  T1TL(1)  =  10HWINC  LOWER 
IF  (  COPUN)  TITL (2)  =  1CHIL  LOWER  N 

CALL  PRINTR!  TITL.IKXE,  EN5LS.1,  l.MXBB.WVBB,  IPNTDW) 

C 

90  CONTINUE 

IF  (NSURF  .EB.  1  .<R.  COPUN)  CO  TO  140 

c 

C  DETERMDC  VMICH  WINC  SURFACE  CONTRIBUTES  TO  'HE  TAIL. 

IF  (CAR.  .CT.  0)  CO  TO  130 

IF  (CAR.  .EQ.  0  .AND.  PSICIF  .CT.  0  >  CO  TO  130 
C  THE  LOWER  WINC  SURFACE  CONTRIBUTES  TO  THE  TAIL 

LIM  =  IFNTDWa  .MX8BWH)  -  1 
DO  120  I  =  1.L1M 
DRUB  (I )  s  E>RLS(I> 

120  CONTINUE 
C 

C  COMPUTE  THE  TAIL  NCR  HAL  WASHES  AND  VELOCITY  POTENTIALS 

130  CONTINUE 

CALL  VELPC7  (  IB0MW(ISU8T,1)  ,LBXCDW,  PKERN. (IPKERN) ,  RCERN., 

1  .F.,  DINT) 

C  OPTIONAL  PRINT  CP  NCR  HAL  WASHES 

IF  (  .NOT.  (CHECK R?  .OR.  PR*V)  )  CO  TO  »3J 

IF  (NSUBDV  .EQ.  1  .CR.  .NOT.  CHECK  PR)  CO  TO  133 

TITL(i)  «  10HEN  SUBOIVI 

TITL (2)  «  10HDED,  UPPER 

TI1UJ!  «  10H,  PARTIAL 

IF  (IPNTIN  .LT.  IPNTOT)  CO  TO  131 

CAU.  PRINT*  (TITL,  IMOCE.CNBUBO, 2,  1,  IPMTHM,  MYBBS, IPNTSD) 

CO  TO  t33 

131  CONTINUE 

CALL  R(lMTR(TITL,lMCeC,CNSW80,*,{PNTO»,lPNTL8-l,NrBB*,IPNT»B) 
CALL  PRINTS  (TITL,  IM0CE.CN8U8D,  2,  1,  IPNTIN-t,  NTBBS,  IPNTSD) 
133  CONTINUE 

TITL  (I )  «  10HTAIL  UPPER 


NWVP*CX  00186 
NWVRCX  00187 
HNH6X  00188 
NWVRCX  00189 
NWVRCX  00190 
MWVPPCX  00191 
NWVRCX  00192 
W*P»X  00193 
NWVRCX  00194 
NWVPPCX  00195 
NWVRCX  00196 
NWVRCX  00197 
NWVRCX  00198 
NWVRCX  00199 
NWVRCX  00200 
NWVRCX  00201 
NWVRCX  00202 
NWVRCX  00203 
NWVPtCX  00204 
NWVPTCX  00205 
NWVRCX  00206 
NWVPtCX  00207 
NWVRCX  00208 
NWVRCX  00209 
NWVR«X  00210 
NWVRCX  00211 
NWVPtCX  00212 
NWVRCX  00213 
NWVPTCX  00214 
NWVRCX  00215 
NWVRCX  00216 
NWVRCX  00217 
NWVPMBX  00218 
NWVRCX  00219 
WWPtCX  00220 
NWVRCX  00221 
NWVRCX  00222 
NWVRCX  00223 
NWVPtCX  00224 
NWVRCX  00225 
NWVRCX  00226 
NWVPTCX  00227 
NWVPtCX  00228 
NWVRCX  00229 
NWVRCX  00230 
NWVRCX  00231 
NWVPtCX  00232 
NWVPtCX  00233 
NWVPtCX  00234 
NWVRCX  00235 
NWVPtCX  00236 
NWVPtCX  00237 
NWVPtCX  00238 
NWVRCX  00239 
NWVRCX  00240 
>AWR«X  00241 
KWVPKBX  00242 
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CALL  PRINTRI  TITL, IMCCE,  EMIUS.l , 
1  1PNTDW(1,I0VUPN  ♦  1) 

TITLd)  =  10KTAIL  LOWER 
CAU.  PRINTRI  TITL, IMCCE,  EMILS, 1. 
1  IPNTCWd.IOVUPN  ♦  1) 

135  CCNTIHC 


IXBUT.MXBT.WfBBT, 

> 

I XBUT ,  MXBT ,  WT8BT , 
> 


C  VUITE  WE  RESULTS  CN  SCRATCH  FILES 

140  CONTINUE 

MARWWd)  =  )**. 

DO  210  I  =1,4 
210  FARM  (I )  =  PARMW(I) 

C 

C  XX  W5ITE  DELTA  fHI3,  TEMPORARILY  AS  A  REAL  MATRIX,  VfcTETP  XX 
►  =  2 

iTYPE  =  4HREAL 

N  =  IPNTRMd.MXB+lCVUPM)  -  1 

CALL  VRTEMXUVPSC.  .F.,  .F.,  *FS,M4S,LS,  M45.LWS,  2,  ID,  DELFHI, 
1  I  TYPE,  M.N.PARM,  IRR) 

IF  (IRR  .NE.  0)  CO  TO  920 
C 

M  =  2 

N  =  NTVP 

CALL  WSTEMXUVPSC,  .F.,  .F.,  fffS.KUS.LS,  M«,  LU5,  2,  ID,  TVP, 

1  I  TYPE,  N,N,  FARM,  IRR) 

IF  (IRR  .ft.  0)  CO  TO  920 
C 

IF  (.NOT.  RRVFJ  CO  TO  230 
TITLCl  >  =  OH  WINC 
TITL  (2)  =  1  OH  VELOCITY  P 
TITLC3)  =  1CHOTENTIALS 
M  =  WX6W 

IF  (.N.  COPUN)  CO  TO  220 
TITLd)  =  10HWI NC/TAIL 
M  =  K’HTRS  -  1 

220  CALL  **INTR(  TITL,  IMCCE,  DELPHI,  1,  1,M,  KfB,  IPNTRM) 

IF  (N5URF  .Efl.  1  .CR.  COPUN)  CO  TO  230 
TITLCl)  =  8H  TAIL 

CALL  PRINTR (  TITL,  IMCCE,  CELFHl,  1,  DCUT.MXBT,  WTBT, 

1  IPNTRM(l,IOVUP+t>  ) 

230  CONTI  NUtl 

C  ARE  SAMPLE  MASHES  DESIRED  - 

IF  (NSURF  ,EB.  2  .OR.  ISMPLW  .EQ.  0)  CO  TO  500 
C  YES.  IS  SAMPLE  WASH  PRINTOUT  DESIRED 

IF  ( .NOT.  ((RDM  .CR.  FRSW)  )  CO  TO  500 
C  LOOP  ON  CHORDS  FOR  WHICH  SAMFLE-WASH  IS  DESIRED 

DO  300  JG-KC  =  1  .ISMPLW 
JT  =  IOKRC(JCHRC) 

IFRST  =  IBCWF(JCHRD) 

I  LAST  =  IBQML(JCHRD) 

aa  1MPLW(  IBOXW.LBXCDW.JCHRD.JT,  IFRST,  IUST) 

300  CONTINUE 

c 

300  CONTINUE 

C  DC  OF  LOOP  ON  MODE  SHAPES,  FROM  STATEMENT  50* 

C 

RETURN 


NWVPVCX  00243 
NWVPVCX  00244 
NWVPVCX  00245 
NWVPVCX  00246 
H.# PVCX  00247 
NWVPVCX  00248 
NWVPVCX  00249 
NWVPVCX  00250 
NWVPVCX  00251 
NWVFVBX  00252 
NWVPVCX  00253 
UWVPVCX  00254 
NWVPVCX  00255 
NW/PVCX  00256 
NWVPVCX  0G257 
NWVPVCX  00258 
HMA6X  00259 
NWVPVCX  00260 
NWVPVCX  00261 
NWVPVCX  00262 
NWVPHBX  00263 
NWVPVCX  00264 
NWVPVCX  00265 
NWVPVCX  00266 
NWVPVCX  00267 
NWVPVCX  00268 
NWVPVCX  00269 
NWVPVCX  00270 
NWVPVCX  00271 
NWVPVCX  00272 
NWVPVCX  00273 
MWVP»CX  00274 
NWVPVCX  0C275 
NWVPVCX  00276 
NVA/WCX  00277 
NWVFVCX  00278 
MWVFVCX  00279 
NWVPMBX  00280 
NWVPVCX  00281 
NWVPVCX  00282 
NWVPVCX  00283 
NWVPMBX  00284 
NWVPVCX  00285 
NWVPVCX  00236 
NWVPMBX  00287 
NWVPMBX  00288 
NWVPVCX  00289 
NWVPVCX  00290 
NWVftCX  00291 
NWVPMBX  00292 
NWVPMBX  00293 
NWVPMBX  00294 
NWVPVCX  00295 
NWVPVCX  00296 
NWVPMBX  00297 
NWVPMBX  0C298 
VWVFMBX  00299 
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c 

C  DIAGNOSTICS  -  ALL  CALL  FLUSH 

C 

C  READING  FROM  SCRATCH  FILE 

910  CONTINUE 

WRITE  (NT6.9100)  ICCC6C 
CO  TO  950 
912  CONTINUE 

WRITE  (NT6.9120)  MCCESC 
CO  TO  950 
920  CONTINUE 

C  WRITING  CN  SCRATCH  FILE 

WRITE  (NT6.9200)  IVPSC 
CO  TO  952 

C  INCORRECT  DIMENSIONS  READ 

930  CONTINUE 
1  =  1 

CO  TO  932 

931  I  =  2 

932  WRITE  (NTS, 9300)  1 
IF  (HXRD)  CO  TO  960 
CO  TO  962 

C  ERROR  DETECTED  READING  A  MATRIX 

993  CONTINUE 

WRITE  (NT6.9500)  IRS 
IF  (WRD)  GO  TO  960 
CO  TO  962 

C  ERROR  DETECTED  WRITING  A  MATRIX 

952  CONTINUE 

WRITE  (NT6.9520)  IRS 
IF  (MXVRT)  GO  TO  960 
WRITE  (NT6.9630)  MXARRY 
CO  TO  962 

C  MATRIX  DESCRIPTION 

960  CONTINUE 

WRITE  INT6.9S00)  UDU' .  1=1 ,10)  ,  (IDO >,  1=1 ,10) 

WRITE  <Nfe,9622)  FARM,  FARM 
WRITE  (NT6,9614)  , W*R , LRS , LW6 

CO  TO  964 

962  WRITE  (NT6.9620)  ID(1),ID(2) 

WRITE  (NT6.9622)  FARM,  FARM 
WRITE  (NT6.9624)  WTS.WHS 
964  WRITE  <NT6,9S40>  ITYPE.M.M 
WRITE  (NTS, 9630)  MXARRY 
CO  TO  990 

990  CONTINUE 

WRITE  (NTS, 9900) 

C 

CALL  FLASH  (1) 

C 

C  DIAGNOSTIC  FORMATS 

WOO  FORMAT (4 TH0**4  ERRCR  WHILE  READING  CECMETRY  SCRATCH  FILE  ,A10, 
1  4H  ***  ) 

9120  FORMAT (44HOM*  ERRCR  WHILE  READING  MOOES  SCRATCH  HLE  ,AtO, 
t  4H  *♦*  ) 

9200  FORMAT  (51H0»«*  ERRCR  WHILE  WRITING  VELOCITY  POTENTIAL  SCRATCH 


NWVPWCX  00300 
NWVP1CX  00301 
NfcWFWCX  00302 
NWVP »CX  00303 
NWVPWCX  00304 
NWVPWCX  00305 
NWVPWCX  00306 
NWVPWCX  CO 307 
NWfc'PMBX  00308 
NWVPWCX  00309 
NWVPWCX  00310 
NWVPMBX  00311 
WMVPWCX  00312 
NWVPMBX  0C313 
NWVPWCX  00314 
WMVPWCX  00315 
WMVPWCX  00316 
WMVPWCX  00317 
NWVPMBX  00318 
NWVPWCX  00319 
WMVPWCX  00320 
WMVPWCX  00321 
NWVFWCX  00322 
NWVFWCX  00323 
WMVPM8X  03324 
WMVPWCX  00325 
WMVPWCX  00326 
WMVPWCX  00327 
WMVPWCX  00328 
NUVFWCX  00329 
WMVFMBX  00330 
NWVPMBX  00331 
NWVPWCX  00332 
NWVPWCX  00333 
NWVPMBX  00334 
NWVPWCX  00335 
NWVPWCX  00336 
NWVPWCX  00337 
NWVPWCX  00338 
NWVPWCX  00339 
NWVPWCX  00340 
NWVPWCX  00341 
NWVPWCX  00342 
NWVPWCX  00343 
NWVPWCX  00344 
NWVPWCX  00345 
NWVPWCX  00346 
NWVPWCX  00347 
NWVPWCX  00348 
NWVPWCX  00349 
NWVPWCX  C0350 
NWVPWCX  00351 
NWVPWCX  00302 
NWVPWCX  00553 
NWVPWCX  00354 
NWVPWCX  00355 
NWvPMBX  00356 


1  6H  FILE  ,A10,  4H  ***> 

9300  PCRMAT(1H0,  48H***  MATRIX  READ  ERROR.  THE  M  DIMENSION  SHOULD 
1  4H  BE  .12,  4H  ***> 

9500  FCRMAT (16H0  m  ERROR  CCCE  ,15,  20H  WHILE  READING  THE  FOLLOWING 
I  11H  MATRIX  *%*  ) 

9520  FOR  HAT  (1840  ***  ERROR  CCCE  ,15,  28H  WHILE  WAITING  THE  FOLLOWING 
1  SiH  MATRIX  0**  ) 

9600  FCRHATH  5X,*MATRIX  ID  =  4.10A10  /  (20X.10A10)  ) 

9614  FCRMAT (  5X.22H MATRIX  I»CEX  (NAME)  =  ,I5,2H  (A10.1H)  / 

1  5X.33HLEVE1.  NJA«ER  READ  (OR  WRITTEN)  =  02, cH  (,02, 1H)  ) 

9620  FCRMAT (  5X.4MATRIX  ID  -  *,  A10,  110  ) 

9622  FORMAT  (  5X.11HFARA  METERS,  10E11.3  /10X,  9H(INTEGER) ,  17,9111) 

9624  FCRMAT (  5X.15HFILE  SPACING  =  ,13,  19H,  MATRIX  SPACING  =  ,13  ) 

9630  FORMAT!  5X.A10.21H  ARRAY  WAS  BEING  USED  ) 

9640  FCRMAT (  5X.4MATRIX  TYPE  -  *,A10,  *,  D1MEN5IOCD  (*I4,*  X*,I4,*)*> 
9900  FORMAT (S4H0***  ERROR  OCCURRED  DURING  VELOCITY  POTENTIAL  CALOJUAY 

1  9HION5  ♦**  ) 
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NWHPHBX  00357 
NWVPMCX  00358 
NWVPACX  00359 
NWHPACX  00360 
MkWPveX  00361 
NWYPMBX  00362 
NWVP »«X  00363 
NWHPVCX  00364 
MWVt^veX  00365 
FTNX1  00056 
NWPMBX  00367 
NWFPBX  00368 
WrfvP)«X  00369 
NWVPP6X  00370 
NWVFVOX  00371 
NWVPVCX  00372 
NnWfVBX  00373 
NWVPHCX  00374 

nw/phbx  00375 


W  fM  •+  Qt  IN)  m* 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 


c 

e 


subroutine  velpctubox.lbxcd.  **eru.,skerm.,  wing,  dims) 

VELPOT  IS  CALLED  ONCE  FCR  EACH  MOCE,  TO  COMPUTE  NO  HAL  WASHES 
A  AC  VELOCITY  POTENTIALS  rO  THAT  MOCE. 

ISO*  =  BO*  CCCES  FCR  THE  SURFACE 
LB*CD  =  BO*  COKE  ARRAY  ROW  DIMENSION 
f*ERH.  =  ARRAY  CONTAINING  C(NU,MU,0> 

SKERN.  =  ARRAY  CONTAINING  SUBDIVIDED  C(NI),MU,0) 

WING  =  LOGICAL,  .T.  FOR  WING  OR  COPUNAR,  .F.  FOR  TA»L 
DIMS  =  LOGICAL,  .T.  TO  INCLUDE  DIHEDRAL  EFFECTS,  S.  TO 

igncre,  fo  wi mowing  (tail/tail; 

DIMENSION  IBOX<LBXCD,l),  ICCCEIS) 

CCMPLE*  TKEkNKI),  SKOifL(l) 

LOGICAL  WING.MHS 


OUTPUTS  - 

DELPHI  =  DELTA  W1  (VELOCITY  POTENTIALS  ARRAY 

CO*«CN  PARAMETERS  USED 

NSLBDV  =  NUM3ER  CF  SUBDIVISIONS 

B1  =  BO*  LENGTH 

BIS  =  SUBDIVIDED  BOX  LENGTH 

00*04  /FILES  /  NT5, NTS, INTAPE, IffSi  .NPLAIC.NSPAIC.NOUTP, 

1  lOLFSP.MCCESC,  IVPSC,  IGEC6C,  IWTFSC,  IAICSC 

C0*04  /ARRAYS/  KBXCCW,LBXCCW,IJOXC,KB*CDT,LBXCDT,KJALFH,LJALfH, 
KAL5HA ,K*ERM.,UERN- . KFNTRM, LFNTRM,  aEFSL , Ka.FHI , 
LMCCES ,  KPNTSC,  LPNTSC ,  KSCV,  LSCW,  KPNTCW,  LPNTDW, 

KOW.l  DW.KTVP.LTVP 

/GtCMTY/  COPLAN, WJBDV,  XSUBCV, NS./BE2 ,  NSUBCN, FSLRF, 

81 , BIBETA, BIS, B1  STAS,  W_AX,  WJ«,  PSIW, 

MYBW,  MXBBW,  MYBW,  MYBBW,  MXBSW,  MYBSW,  MTBBSW, 
iXBW.rcEmR 

LOGICAL  COPLAN 

CCM40N  /CECM2  /  TLAX, TLAZ , PSIT, MXBT , WBT , MYBbT , MXBST , WBST , 

1  MYBBST  i  I*BT  •  I  XBS7.CAFL 

C0#0(  /  MOPES/  SYM.SYMT.KTYPEW.MTYFET 

00*04  /KM  ICS/  YBARiEL ,  MIMIC  (2, 50)  ,  NICWS.SLRF, 

1  YBARL.ELL,  MUAICL (2, 50) , TRCMRL.SURFL,  PSIDIF 

LOGICAL  SURF, SLR FL 

C0*04  /AICS  /  *VL,  C«640)  ,W<1640)  ,V(1640) 

COMPLEX  C,  W,  V 

DELWI  (LMOCFJ)  .TVP(LTVP) ,  TE10.0C  (LTVl’J 
CQ*<H  /DEL TAP/  DELPHI  (103C) ,  TVP(250),  TE*LCC(250>,  FEXL0C(250), 

1  IPNIRM<2,100)  .NPNTRS.  IOVUP 

CCMPLE*  DEL*Hl ,  7  VP 

DEFSL  (2,  LMCCES) 

MANSION  DC/SL  (2,1000) 

GBUt VALENCE  (DELPHI (81)  *  DEFSL) 

ARRAYS  DELPHI  AND  DEFSL  ARE 

EflUlVALENCED  TO  GIVE  A  2  ROW  UN- OVER  UPPED  SECTION 
COMMON  /NWASHES/  I PNTrW(2 , 100)  EW<US  (1273) ,  ENRIS (1275) ,  ICVLAPN 
COMPLEX  EfRUS,  EFRLS 

COMMON  /SNW.SH/  IPNTSD<2,50)  ,  EN5UDC (2, 600)  ,  I  PNTI N,  I PNTOT  ,  I PNTLS 


VELPOT  00002 
VELPOT  00003 
VELPOT  00004 
VELPOT  00005 
VELPOT  00006 
VELPOT  00007 
VELPOT  00008 
VELPOT  00009 
VELPOT  00010 
VELPOT  00011 
VELPOT  00012 
VELPOT  00013 
VELPOT  00014 
VELPOT  00015 
VELPOT  00016 
VELPOT  0001/ 
VELPOT  00018 
VELPOT  00019 
VELPOT  00020 
VELPOT  00021 
VELPOT  00022 
VELPOT  00023 
VELPOT  00024 
VELPOT  00025 
VELPOT  00026 
FILES  00002 
FILES  00003 
ARRAYS  00002 
ARRAYS  000G3 
ARRAYS  00004 
ARRAYS  OOOC5 
GECMTY  00002 
GECMTY  00003 
GECMTY  00004 
GECMTY  00005 
GE04TY  OOOC6 
OF CM2  00002 
GECK>  00003 
MCCCCM  00002 
VE1.POT  00032 
MUAICS  00002 
KUAiCS  00003 
MUAICS  00004 
AICS  00002 
AICS  00003 
DELTAP  00002 
DELTAP  00003 
DELTAP  00004 
DELTAP  00003 
DELTAP  0000* 
DB.TAP  00007 
DELTAP  00008 
DELTAP  00009 
DELTAP  00010 
NW4SHES  00002 
NWAVIES  00003 
SNURSH  00002 
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c 

IRNT3D(t.PNTSD) ,  ENSUBD  C2H.SDW) 

SNWASH 

00003 

COMPLEX  ENSUBD 

SNWASH 

00004 

c 

IBOXWCLBXCDW.LBOXC),  WHERE  LBOXC  =  LSCHDS/20 

BXCDES 

00002 

COMCN  /BXCDES/  IBOXWdSOiS) 

BXCDES 

00003 

c 

IBOKW  IS  USED  FOR  BOTH  WING  AND  TAIL  BOX  CODES 

BXCDES 

00004 

CO*HON  /CHECK  BI/  DPPCPR.CEOCHt .MCCCflR , AICCB? , M*CPR .SMCfR , CAFCFR 

CHECKER  00002 

LOGICAL  DPPCfR,  CEOCfR,  MOOCBi.  AICCPR , NWSCR? ,  SMCIR,  GArcfR 

CHECK  PR  00003 

EQUI VALENCE  (CHECK  PR.NU6C  PR) 

VELPOT 

00040 

LOGICAL  CHECK B? 

VELPOT 

00041 

c 

VELPOT 

00042 

COMPLEX  AZERO,  DELBHi  CELBiAiCELBHBiDELBHCi  B,  SDELBH.CCEF 

VELPOT 

0C043 

COMPLEX  EW<ULU(30)  #ENRLLL<50>  ,EN<URW(50)  ,EPRULW(50) ,  DfHIL(SO) 

VELPOT 

00044 

COMPLEX  EK3IF,  ENSUM,  EN5RUS.ENSRLS 

VELPOT 

00C45 

COMPLEX  ENSBD(2) 

VELPOT 

00046 

EQUIVALENCE  (ENSRUSiENSBCd  )  i  ■  (ENSKLS,  E76BD(2> ) 

VELPOT 

00047 

c 

VELPOT 

00048 

LOGICAL  CROW,  PROW,  LRCJW,  CBOX,  FT90X,  LB  OX,  SUB  OFT 

VELPOT 

00049 

LOGICAL  FULLBX(SO) 

VELPOT 

00050 

INTEGER  WW.TT.RWT.LWr 

VELPOT 

00051 

COMPLEX  XI NIT 

FTNX1 

00057 

DIMENSION  XINITX(2) 

ftnxi 

00058 

EQUIVALENCE  (XINIT.XINin) 

FTNX1 

00059 

DATA  WW«TT,RWT,LWT  /l, 2, 3, 4/ 

VELPOT 

00052 

c 

THESE  VALUES  MAY  BE  MODIFIED  BY  ACTUAL  PAIC—  ARRAYS  READ  IN 

VP  POT 

00053 

DATA  XINITX  /  2*  377D4QOCXXXX)OOOOCXX»B  / 

FTNXI 

000 PO 

c 

VELPOT 

00C56 

c 

SET  CONSTANTS 

VELPOT 

0C0  5  7 

c 

1X8  =  sue  Cl  VICED  SUBSCRIPT  CP  FIRST  BjANFCRM  CCNTRCL  POINT 

VELPOT 

00058 

c 

IXBS  =  SUBSCRIPT  OF  FIRST  PLA STORM  SUBDIVIDED  BCK 

VELPOT 

00059 

c 

IXBU  =  UMSUB  DIVIDED  SUBSCRIPT  OF  FIRST  FLA  NT CRM  CONTROL  PT. 

VELPOT 

ooo  a) 

c 

MYBB  s  NJKJER  CT  UNBUBCI VICED  CHORDS  TO  CONSIDER,  INCLUDING 

VELPOT 

00061 

c 

DIAPHRAGM 

VELPOT 

00062 

c 

WYBBS  =  NUMBER  OF  SUBDIVIDED  CHORDS  TO  CONSIDER,  INCL.  DIAFH. 

VELPOT 

00063 

c 

MXB  =  LAST  IJNSUBDIVIDEB  ROW  TO  CONSIDER 

VELPOT 

00064 

c 

MXJJS  =  LAST  SUBDIVIDED  ROW  TO  CONSIDER  (TO  LAST  CONTROL  PNT) 

VELPOT 

OGOS5 

IF  (WING)  GO  TO  80 

VELPOT 

0uG66 

IOVLP  =  IOVLAP 

VELPOT 

00067 

IOVLPN  s  ICVLAPN 

VELPOT 

00068 

RSIS  =  PS  IT 

VELPOT 

00069 

1X8  =  IXBT 

VELPOT 

00070 

IXBS  =  IX8ST 

VELPOT 

00071 

IXBU  =  (IXBT  -  I XBW)/NSUBDV  ♦  1 

VELPOT 

00072 

WYCB  =  NYBBT 

VELPOT 

00073 

MTBBS  r  SflfBBST 

VELPOT 

00074 

BYWTV  r  SYWT 

VELPOT 

00075 

GO  TO  90 

VELPOT 

C0076 

BO  CONTINUE 

VELPOT 

00077 

ICWLR  =  0 

VELPCV 

00078 

IOVLPN  =  0 

VELPOT 

00079 

RSIS  =  PSIW 

VELPOT 

00080 

I>«  *  IXBW 

VELPOT 

00081 

IXBS  *  1 

VELPOT 

00082 

IXBU  x  1 

VELPOT 

00083 

STMTY  x  SYM 

VELPOT 

00084 

IF  (CORLAN  .AND.  NSURF  .E«.  2)  GO  TO  «5 

VELPOT 

00085 

MYBB  s  MYBBW 

vaPOT 

00086 

MYBBS  =  MYBBSW 

VELPOT 

0008  7 
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WWW 


MX8  -  MX8BU 

MXB3  =  OOQ~l)*»fiUBt>V  ♦  ixsw 
HX85  :  MAX)(M»8S,MXBSW) 

CO  TO  100 
BS  CONTINUE 

MT  BA  =  MAX)  (WTBBW,  WTBBT) 

KTBBS  s  MAX)  (MYBBSW,MYBBST) 

90  CONTINUE 
MXB  =  MX8T 
WX83  a  MX8ST 
C 

100  CONTINUE 

MSI  52  =  2*PSIS 
MSI  SUM  =  PSIW  ♦  PSIT 
CMS  IS?  =  CCS  (PSIS2) 

SPSIS?  =  SINIPSIS2) 

CMS ISM  -  CC6 (PSISUM) 

S  PS  ISM  =  SIN(PSiSUM) 

IRFB  =  1X8  -  NSUBDZ 

C  a  ROM  OF  FIRST  SUBDIVIDED  BOX  IN  THE  FIRST  ROW  OF  THE 

C  UNSUBDIVIDED  BOXES 

MTBBS  X  =  (  (MTB5S+N5UBC2)  /ICUBDV)  ♦NSl'BDV 
IF  (NSUBDV  ,E8.  1)  CO  TO  110 
SUBOFF  =  .F. 

MTBBPI  s  MTBBM 
DO  105  I  =  1, MTBBPI 
EN?ULU<I)  s  (D.,0.) 

ENSLLL(I)  =  0).,0.) 

ENrURW(I)  =  (D.,0.) 

ENiULW(I)  =  (0..0.) 

FULLBX(I)  =  ,T. 

105  CONTINUE 
CO  TO  120 
110  SUBOFF  =  .T. 

CROW  =  .T. 

LROW  a  .T. 

FBOK  =  .T. 

CBCM  =  .T. 

LBO*  =  .T. 

LOOP  ON  ALL  (SUBDIVIDED)  ROWS  OF  THE  SURFACE 
120  CONTINUE 

FLIRQW  a  aOAT(IXBS)  -  1.0 
DO  1300  IRON  =  IXBSiMXBS 
THROW  =  FLIROW  ♦  1.0 

C  BET  FUAC«  FOR  FIRST,  CENTER  AX!  LAST  SUBDIVIDED  ROW  IN  UN¬ 
CI  SUBDIVIDED  ROW 

ir  (SUBOFF)  CO  TO  ZR3 

mow  *  ,r. 

IF  (IAOW  -  1X81  250,220,210 
«0  IF  (MOO (IRON- 1X8,  M1U80V)  0)  CO  TO  240 

220  CROW  *  .T. 

CO  TO  250 
250  CROW  =  .f. 

IF  <ir,CW  .13.  I!CBS  .CR.  !ROW  IRFB)  TRCW  =  .T. 


VELPOT  00088 
VELMOT  00089 
VELPOT  00090 
VELPOT  00091 
VELPOT  00092 
VELPOT  00093 
VELPOT  00094 
vapor  00095 
vapor  00096 
VaPOT  0009 7 
vapor  00098 
vapor  00099 
vapor  ooioo 
vapor  ooioi 
vapor  00102 
vapoi  ooi)3 
vapor  aoi04 
vapor  ooios 
vapor  00106 
vapor  00107 
vapor  ooioe 
vapor  00109 
vapor  oono 
vapor  oom 
vapor  00112 
vapor  ooii3 
vapor  ooiu 
vapor  oom 
vapor  00116 
vapor  ooui* 
vapor  ooii8 
vapor  or  t9 
vapor  00120 
vapor  00121 
vapor  00122 

VaPOT  00.23 
uapor  ooi24 
VaPCT  00125 

vapor  00126 
vapor  ooi27 
vapor  ooi28 
VLLPOr  00129 

vapor  ooi  30 
vapor  ooi3i 
vapor  ooi32 
vapor  00133 
vapor  00134 

VO.  POT  00131 

vapor  00136 
vapor  00137 
vapor  00138 
VELPOT  00139 

va^or  00140 
vapor  ooi4i 
VEl.POT  00142 
vopot  00143 
vaPOT  oo!4< 
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CO  TO  250 

VELPOT 

00145 

240 

CRON  =  .F. 

VD.POT 

00146 

I  s  MCC  <IRCW»N5UBCN  -  1X3,  N5UBCV) 

VELPOT 

00147 

IF  (I  -  1)  260.245.250 

VQ.PCT 

□0149 

245 

FROM  =  .T. 

VELPOT 

00149 

250 

LROW  =  .F. 

VELPOT 

00150 

IF  (JRCW  .NE.  HX8S)  CO  TO  270 

VELPOT 

00151 

260  LRCW  =  .T. 

VELPOT 

00152 

C 

VELPOT 

00153 

C 

SET  THE  SUBDIVIDED  RON  NLA4JER  FCR  THE  CENTER  CF  THE  ASSOCIATED 

VELPOT 

00154 

C 

•JTiOSDt VIDEO  BOX,  KENT 

VELPOT 

00155 

2*0  CONTINUE 

VELPOT 

00156 

IF  (CRCV?)  CO  TO  340 

VELPOT 

00157 

IF  (IRCW  -  IRFB)  310,320,330 

VELPOT 

00158 

C 

NO  FULL  RO? 

VELPOT 

00159 

510 

I CENT  =  0 

VELPOT 

00160 

IUCENT  =  0 

VELPOT 

00161 

TCDCEN  =  0 

VELPOT 

00162 

CBCK  =  .r. 

VELPOT 

00163 

LB  C*  r  .r. 

VELPOT 

00164 

CO  TO  355 

VELPOT 

00165 

320 

icewt  =  1X8 

VELPOT 

00166 

CO  TO  330 

VELPOT 

00167 

330 

ICENT  =<<TR0W-IRFB!/T6UBDV)*NSL'’DV  ♦  IXB 

VELPOT 

00166 

IF  (ICENT  ,VT.  MXRS)  ICENT  =  ICENT  -  NSl«DV 

VELPOT 

00169 

CO  TO  3W 

VELPOT 

00170 

340 

ICENT  =  IRCW 

VELPOT 

00171 

C 

vapor 

00172 

330  CONTINUE 

vapor 

00173 

IUCENT  =  (ICENT- IXBWJ/I6U0DV  ♦  1 

vaFor 

00174 

355  CONTINUE 

vapor 

00175 

JEW.OC  =  1 

vapor 

00176 

IF  (.NCR.  WINC)  J EW.CC  t  MTBSW  ♦  1 

vapor 

00177 

C 

vapor 

00178 

C 

LCCF  ON  ALL  (SUBDIVIDED)  CHCRDS  FCR  THE  SURFACE  AM5  DIAPHRAGM 

VELPOT 

OOlTg 

C 

vapor 

00180 

DO  1200  JCCL  =  1  .MTBBSX 

VELPOT 

00181 

C 

vapor 

00182 

C 

CET  THE  CURRENT  (SUBDIVIDED)  BOX  CCCE 

vapor 

00183 

CALL  DCCCER  (IBOX.LBXCD,  IRCW,  JCCL,  IRCW.JCO.,  .T.,  NCDBOX) 

vapoT 

00184 

ir  (3UBCFF)  CO  TO  400 

vapor 

00185 

C 

vapoT 

00186 

C 

-  - 

-  - 

vapoT 

00187 

C 

vapor 

00188 

r 

CET  PfCRMATICN  ABOUT  POSITION  WITHIN  UNSUBDIVICED 

BOX 

vapor 

00189 

c 

vapor 

00190 

c 

ICENT  a  I -LOCATION  (SUBDIVIDED)  OF  THE  CONTROL 

POINT 

vapcnr 

00191 

c 

JCENT  =  ;-LOCATICN  (SUBDIVIDED)  CF  THC  CCNTRCL 

POINT 

vapoi 

00)92 

c 

IUCENT  =  UNSUBDIVICED  I-LOCATICN  OF  ASSOCIATED  CONTROL 

POINT 

vapor 

00153 

c 

JUCENT  s  UNSUBDIVICED  J-LOCATICN  Cf  ASSOCIATED  CCNTRCL 

POINT 

VELPOT 

00194 

c 

JPCENT  s  UNSUBDIVICED  I-LOCATICN  OF  THE  NEAREST 

planfcrn 

vapoT 

0C195 

c 

CCNTRCL  POINT,  IF  THE  SUBDIVIDED  BOX  IS  ON-PLAWCKM 

vapor 

00196 

c 

CBCK  s  .T,  ,  CURRENT  BOX  IS  A  CENTER  BOX 

VO.  POT 

00197 

c 

LB  OX  =  .T.,  7HIS  IS  THE  LA3T  BOX  ASSOCIATED  WITH  THE 

CONTROL 

.  vapor 

00198 

c 

POINT 

VELPOT 

00199 

c 

NCDCEN  s  CODE  FCR  CONfSCL  POINT 

VELFOT 

00200 

c 

NCDBOX  z  CCCE  FCR  THE  CURRENT  SUBDIVIDED  BOX 

VEl  POT 

00201 

B  i  36 


c 

1 1 CENT  =  I-LCCATION  (SUBDIVIDED)  FCR  THE  NEA^T  FVANFCF.M 

VELPOT 

00202 

c 

CCNTRCL  POINT 

VELPOV 

00203 

c 

VELPC71 

00204 

LB OX  =  .F. 

VELPOT 

0020 i 

JUCEN1  =  (JCO.  -N5UBCN) /XSUBDV  +1.5 

VEi.FOT 

00205 

JCENT  =  F6UBCV  *  JU.'ENT  -  NSUBD2 

velpot 

0020? 

IF  (.NOT.  CROW)  GO  TO  41.0 

VELPOT 

00208 

IF  (JCENT  .ft.  JCCL)  CO  TO  410 

VELPOT 

00209 

CBOX  =  T. 

VELPOT 

00210 

MCDCEN  =  NfCBOX 

VELPOT 

00211 

1 1  CENT  =  IRCW 

VELPOT 

00212 

IF  (NCCBOX)  450,1100,450 

VELPOT 

00213 

c 

CET  CENTER  BOX  CCCE.  NCCCEN 

VELPOT 

00214 

410 

CBOX  =  .F . 

va  POT 

00215 

NCDCEN  =  0 

va  w 

00216 

IF  (ICENT  .LE.  0)  GO  TO  414 

VELPOT 

0021? 

CALL  DCCCER  (IBOX.LBXCD,  ICEN\ JCENT .  ICENT, JCENT,  .T.,  NCDCEN) 

VEL^T 

IXJ218 

1 1  CENT  =  ICENT 

VELPOT 

00219 

CO  TO  418 

VELPOT 

00220 

414 

I ICENT  =  IXB  -  NSI'jBCV 

VElPOf 

00221 

c 

VELPOT 

00222 

418 

CCNTIM.it 

VELPOT 

00223 

IF  (NCCBCK  -  1)  420,424,450 

VELPOT 

00224 

c 

SUBDIVIDED  BOX  IS  NOT  CCNSICEREC  (CCCE  =0).  IF  CENTER  CCCE 

VELPOT 

0022: 

c 

IS  ALSO  ZERO,  LOOP  TO  NEXT  BOX.  OTHERWISE,  CiLCX  FCR  LAST  BOX 

VELPOT 

00226 

4ao 

IF  (NCCCEN)  450,1100,450 

VELPOT 

0022? 

c 

VELPCJT 

C2228 

c 

SUBCIVICED  BOX  CCCE  =  1.  CHECX  VH  ETHER  ITS  CCNTRCL  FT  -  1 

“EL  POT 

00229 

424 

CONTINUE 

VELPOT 

00230 

IF  (.NOT.  CQPLAN)  GO  TO  431 

v, El  pot 

00231 

IF  (TEXLOC(JEXLOC)  .LT.  FUROW)  JEXLOC  =  JEXLOC  ♦  HTESW 

VELPOT 

00232 

IF  (FEXLOC (JEXLOC)  .GT.  FUROW)  JEX.OC  =  JEXLOC  -  MTBSW 

VELPOT 

00233 

c 

DETERMIFt  VH  ETHER  SUBDIVIDED  BOX  IS  CN  SAME  PLAttCRM  AS 

VELPOT 

00234 

c 

I  ICENT  (LOCATION  OF  FEAR  GST  CONTRCL  POINT) 

VELPOT 

00235 

IF  (JEXLOC  .EO.  JCOL)  GO  TO  428 

V£V*X 

00236 

c 

SUBCIVICED  BOX  IS  CN  THE  TAIL.  IS  IICENT  CN  THE  WING  - 

vapor 

0023? 

IF  (FLOAT (I I CENT)  .LE.  TETtOC  (JCENT)  >  GO  TO  432 

VELPOT 

00236 

c 

NO.  CHECK  FCR  IICENT  CFF-PLAIf CRM. 

VELPOT 

0U.r39 

GO  TO  431 

VELPOT 

00240 

c 

SUBCIVICED  BOX  IS  CN  THE  WING.  IS  IICENT  AFT  OF  THE  WING  T.E. 

VELPOT 

0C241 

428 

IF  (FLOAT <1  ICENT)  .GT.  TE XL OC  (JCENT)  )  GO  TO  432 

VELPOT 

00242 

c 

NO.  CHECK  FCR  IICENT  OFF-  FLA  It  CRM  (L.E.  DlAfHRAGM) 

VELPOT 

0024  j 

431 

CONTINUE 

VELPOT 

00244 

c 

CHECK  CCCE  AT  IICENT  (FCARE5T  CONTRO.  POINT) 

VELPOT 

00245 

IF  (NCDCEN  .02.  1)  CO  TO  450 

VELPOT 

00246 

c 

SUBDIVIDED  CN-PLAFECRM  BOX  DOES  NOT  LIE  WITHIN  AN  UNSUBDIVIDED 

VELPOT 

U0247 

c 

BOX  W406E  CCNTiCL  POINT  IS  ON  TO  ft  CRM.  SEARCH  FCRE  AND  AFT 

VELPOT 

00246 

c 

FOR  THE  FCAREST  CCNTRCL  POINT  CN  THE  SURFACE. 

VELPOT 

00249 

432  CONTINUE 

vapor 

00250 

JFCCM?  =  I FI X (FEXLOC (JEXLOC > )  ♦  1 

VELPOT 

00251 

ILCCH?  =  TCXLCC  (JEXLOC) 

VELPOT 

00252 

I MAX  s  24NSUBDV 

VELPOT 

00253 

DO  430  I  s  NSUBDV.IHC*  (SUBDV 

VELPOT 

00254 

HCEMT  ~  KENT  > I 

VELPOT 

00255 

IF  (IICENT  JA.  ILCOR)  GO  TO  434 

VELPOT 

002*.  6 

CALL  DC ODER  (IBOX.lSXCC,  IICENT, JCENT,  IICENT, JCENT,  .T.,  NCO) 

VELPOT 

0025? 

IF  (NCC  .EO.  1)  CO  ",  4'0 

VELPOT 

002  56 

m/ 


434  CONTI HUE 

IICENT  =  I  CENT- 1 

ir  (IICENT  .LT.  1FCOR)  CO  TO  43B 

CALL  DCCEERdBOX.LBXCD,  ?  I  CENT ,  JCENT ,  IICENT,  JCENT,  .T. ,  NCC) 

IE  (NCC  .EB.  1>  CO  TO  440 
4SS  CONTI  NIC 

C  NO  CENTER  BOX  ECU®.  A  WARNING  DIA0NC6TIC  WILL  BE  PRINTED, 

C  THEN  COMPUTATION  WILL  CONTINUE  AT  420 

CO  TO  3010 

C  A  BOX  WAS  ECU® 

440  CONTINUE 
C 

C  THE  ASSOCIATED  CONTROL  POINT  HAS  BEEN  FOUNt.  CET  THE  UNSUB- 

C  DIVIDED  SUBSCRIPT. 

450  CONTINUE 

IPCENT  =  ( I  ! CENT- 1 X8W)  /NSUBDV  ♦  1 

IF  (LfiCW)  CO  TO  470 

IF  (.NOT.  FRCW)  CO  TO  460 

IF  (JCCL  .TC.  JCENT-NSUBK)  CO  TO  460 

FUCK  -  .T. 

CO  TO  500 
460  CONTINUE 
HJOK  =  .F. 

CO  TO  500 
470  CONTINUE 

IF  (JCCL  .03.  JCENT*K6UBC2>  LBOK  =  .T. 

FBON  =  .F. 

CO  TO  500 
C 

C  . -------------- 

c 

c  SET  UP  VALUES  FCR  AN  U6UBCI VICED  CaSE 

C  TEST  FCR  NCN-ZEKO  BOX  CCCE  - 

^  c«»  COfTINUE 

IF  (NCCBC*  .03.  0)  CO  TO  1100 
I  CENT  =■  IRC W 
IICENT  =  I  CENT 
I UCENT  =  I  CENT 

jcent  =  jca 

JUCENT  r  JCCL 
CBC*  =  .T. 

LBOK  =  .T. 

NCOCEN  -  NCCBOX 
FB<*  =  .T. 

IPCEMT  =  ICENT 
C 

500  CONTINUE 

IF  (NCCBOX  .CT,  0)  CO  TO  510 
FULLBXC  JUCENT)  =  .F. 

IF  (LBOK)  CO  TO  1040 
IF  (FBOOO  CO  TO  515 
CO  TO  1100 
C 

C  THE  BOX  IS  TO  fc"  CCNSIDEKEC.  ARE  N-HAT  TERMS  ACCESSARY  - 

510  CCMTINl* 

C  ARC  N-HAT  TERMS  ALRLaCY  AVAILABLE  - 

IF  (FBOX)  CO  TO  515 


VELPOT  00259 
VELPOT  00260 
VELPOT  00261 
VELPOT  00262 
VELPOT  00263 
VELPOT  00264 
VELPOT  00265 
VELPOT  00266 
VELPOT  00267 
VELPOT  00268 
VELPOT  00269 
VELPOT  002 7D 
VELPOT  00271 
VELPOT  00272 
VELPOT  00273 
VELPOT  00274 
VELPOT  00275 
VELPOT  00276 
VELPOT  00277 
VELPOT  00278 
VELPOT  00279 
VELPOT  00280 
VELPOT  0G281 
VELPOT  00282 
VELPOT  00283 
VELFOT  00284 
VELPOT  00285 
VELPOT  00286 
VELPOT  rr287 
VELPOT  0G288 
VELPOT  00289 
VELPOT  00290 
VO  POT  00291 
VELPOT  00292 
VELPOT  00293 
VELPOT  00294 
VELPOT  00295 
VELPOT  00296 
VELPOT  00297 
VELPOT  00298 
VELPOT  00299 
VELPOT  00300 
VELPOT  00301 
VELPOT  00302 
VELPOT  00303 
VELPOT  00304 
VELPOT  00305 
VELPOT  00306 
VELPOT  00307 
VELPOT  00308 
VELPOT  00309 
VELPOT  00310 
VELPOT  00311 
VELPOT  00312 
VELPOT  00313 
VELPOT  00314 
VELPOT  00315 


B138 


c 

c 

c 

c 

c 


c 


c 


c 


c 

c 


IF  (NCCBOX  .♦€.  1)  CO  TO  860  VELPOT 

IF  (.NOT.  WING)  GO  TO  810  VELPOT 

IF  (IPCENT  .»£.  IUCENT)  CO  TO  650  VELPOT 

CO  TO  $50  VELPOT 

VELPOT 

-----------  -  ---------  -  VELPOT 

VELPOT 

CCMfVTE  N-HAT  TERMS  FCR  THIS  (UNSUBDIVIDED)  BOX  VELPOT 

VELPOT 

515  CONTINUE  VELPOT 

E7RLLUUUCENT)  =  (0.  ,0.)  VELPOT 

E>RLLL<JUCENT>  =  <0.,0.)  VELPOT 

DWIL(JUCENT)  =  <0.,0.)  VELPOT 

ARE  LEFT  SURFACE  CONTRIBUTIONS  POSSIBLE  -  VELPOT 

IF  ( IUCENT- 1 XBU  .LT.  JUCENT)  CO  TO  600  VELPOT 

IF  (PSIS  .Efi.  0  .CR.  .NOT.  CIHS)  CO  TO  600  VELPOT 

GET  AIC  ARRAYS  W  ATC  V  FOR  LEFT  SURFACE  INFLUENCE  ON  RT  SURFACE  VELPOT 
CALL  CETAIC (JUCENT, WW,  0,  IR)  VELPOT 

IF  (IR  .NE.  0)  CO  TO  600  VELPOT 

NdBMtN  =  JUCENT  VELPOT 

NJBMAX  =  IUCENT  -  IXSU  VELPOI 

I  =  IUCENT  -  JUCENT  VELPOT 

YHUCAR  =  C06(2*PSISI*  (JUCENT-. 5)  VELPOT 

JBAR  =  YMUBAR  ♦  1  VELPOT 

CCT  REFERENCE  LOCATION  IN  AIC  ARRAYS  VELPOT 

IF  CYBAR)  520,525,530  VELPOT 

520  JINCR  =  1  VELPOT 

CO  TO  535  VELPOT 

325  I  AIC  -  NUBMINW2  VELPOT 

INCAIC  =  2WJUEMI N  ♦  1  VELPOT 

JINCR  =  -1  VELPOT 

CO  TO  540  VELPOT 

530  JINCR  =  -1  VELPOT 

535  IAIC  =  NLBMIM**2  ♦  NUBMIN  VELPOT 

INCAIC  -  ?*NUBMIN  ♦  2  VELPOT 

VELPOT 

LOOP  FORWARD  OF  box  FCR  WING/ WING  (TAIL/TAIL)  N-HAT  TERMS  VELPOT 

540  CONTINUE  VELPOT 

DO  590  NUBAR  =  NUBMIN, NUBMAX  VELPOT 

MUAIC1  =  MUAIC  (1  .NUBAR+l  I  VELPOT 

MUAIC2  =  MUAIC  (2,  NUBAR+1 )  VELPOT 

IF  (MUAIC2  .Efl.  0)  CO  TO  585  VELPOT 

IF  CYBAR  .CE.  0)  CO  TO  550  VELPOT 

JCCLL  =  -JBAR  -  NUBAR  ♦  MUAIC1  VELPOT 

CO  TO  560  VELPOT 

550  JCCLL  =  -JBAR  ♦  NUBAR  -  MUAIC1  ♦  2  VELPOT 

WO  CONT I  Nut  VELPOT 


C  VELPOT 

C  LOOP  LEFT  CF  RECEIVING  CHORD  TO  CCT  LEFT  SURFACE  CONTRIBUTIONS  VELPOT 

DO  580  HUAI  s  MUAIC1  .MUAIC2  VELPOT 

IF  (JCCLL  .LC.  0)  CO  TO  5*0  VELPOT 

CALL  DCCOEROBOX.LBXCO,  l, JCCLL.  1. JCCLL.  .F.,  ICO)  VELPOT 

IF  (ICD  .E9.  0)  CO  TO  570  VELPOT 

C  A  CONTRIBUTING  BOX  HAS  BEEN  FOUTC.  CCT  THE  AIC  LOCATION  VELPOT 

MIC  s  IAIC  ♦  MUAI  VELPOT 

C  CCT  LOCATION  IN  N  ARRAYS  FCR  THE  VALUES  AT  BOX  (J, JCCLL)  VELPOT 

ICS  s  LOCSCWII  .  JCCLL  .  I  PNTCW.LPNTCW,  1,  LPNTCW)  VELPOT 


00316 

00317 

00318 

00319 

00320 

00321 

00322 

00323 

00324 

00325 

00326 

00327 

00328 

00329 

00330 

00331 

00332 

00333 

00334 

00335 

00336 

00337 

00338 

00339 

00340 

00341 

00342 

00343 

00344 

00345 

00346 

00347 

00348 

00349 

00350 

00351 

00352 

00353 

00354 

00355 

00356 

00357 

00358 

00359 

00360 

00361 

00362 

00363 

00364 

00365 

00366 

00367 

00368 

00369 

00370 

00371 

00372 
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COT  =  <  CPSI$2*W(KA!C)  -  $PSIS2*V(KAIC)  >  *  SYMTY 

EMULU(JUCCNT)  =  EKRUSUDSXQET  ♦  ENRULU(JUCENT) 

EMLCL ( J UCENT )  =-EN<LS(IDS>«CCEF  ♦  EVJiLLL  (JUCENT) 

DRHL(JUCENT)  =  (EH; US  (IDS)  -  EN<IS(ID$>  )  *  C(KAIC)  *  SYMTY  ♦ 

1  DRdL(JUCENT) 

5 't)  CONTINUE 

c 

JCCLL  =  JCCLL  ♦  JINCR 
590  CONTINUE 

C  EM)  OF  LOOP  FCR  LEFT  ROW  CONTRIBUTIONS 

C 

585  CONTINUE 

I  =  I  -  t 

IF  (I  .LT.  IWU)  GO  TO  600 
IAIC  =  INCAIC  ♦  IAIC 
ItCAIC  =  INCAIC  ♦  2 
590  CONTINUE 

C  EM)  OF  LOOP  FORWARD  ON  ROWS,  TO  COMPUTE  LEFT  SURFACE  OUT-OF- 

c  flaw:  effects,  frcm  sao 

c 

C  IF  THIS  IS  AN  CN-R.AKFCRM  TAIL  BOX,  THERE  ARE  WING-TAIL 

C  CONTRIBUTIONS 

800  CONTINUE 

IF  (WING)  CO  TO  830 
EMiURW(JUCENT)  =  <0.,0.) 

EMULW(JUCENT)  =  (0.,0.) 

IF  (NCUCEN  .TC.  1)  GO  TO  860 
C 

C  CONFUTE  the  RIGHT  WING  CONTRIBUTION  TO  THE  TAIL  BOY 

II  =  1 

IF  (PSIW  .EQ.  PSIT)  II  =  2 
CALL  GETAIC(JUCENT,RWT,  Ii,  IR) 

IF  (IR  0)  GO  TO  TOO 
HJBMIN  =  ABS (EL)  ♦  .5 
NUB  WAX  =  IUCENT  -  1 
I  =  IUCENT  -  NUENIN 

YMUBAR  =  (JUCENT  -  .5)  *  C06(PS!CIF)  ♦  CAR.  *  SIN(PSIW) 

JBAR  =  YMUBAR 

IF  (YMUBAR  .C£.  0)  JBAR  =  JBAR  ♦  t 
IF  (YBAR)  620,625,630 
620  JINCR  =  -1 
CO  TO  635 

625  IAIC  =  NUBMIN**2 

INCAIC  =  2*NUBMIN  ♦  1 
JINCR  =  1 
CO  TO  640 
630  JINCR  =  i 

835  IAIC  =  NJBMINW2  ♦  MJBMIN 
INCAIC  s  2ANUBMIN  ♦  2 
840  CONTINUE 
C 

C  LOOP  FORWARD  CNER  THE  RIGHT  WING 

DO  690  NUBAR  s  HUBMIN.NUBHAX 
MUAIC1  s  MUAIC  (1 ,  NUBAR*  1 ) 

MLIAIC2  *  MUA I C  (2 ,  NUBAR  ♦  1 5 
IF  (MUAIC2  .CO .  0)  GO  TO  685 


VEL°OT  003T3 
VtLPOT  00374 
VELPOT  00375 
VELPOT  003T6 
VELFOT  003T7 
VELPOT  00376 
VELPOT  00379 
VELPOT  00380 
VELPOT  00381 
VELPOT  00382 
VELPOT  00383 
VELPOT  00384 
VELPOT  00385 
VELPOT  00386 
VELPOT  00387 
VELPOT  00388 
VELPOT  00389 
VO.FOT  00390 
VtLPOT  00391 
VELPOT  00392 
VELPOT  00393 
VELPOT  00394 
VELPOT  G0395 
VELPOT  00396 
VELPOT  00397 
VELPOT  00398 
VELPOT  00399 
VELPOT  00400 
VELPOT  00401 
VELPOT  00402 
VELPOT  00403 
VELPOT  00404 
VELPOT  00405 
VELPOT  00406 
VELPOT  00407 
VELPOT  00408 
VELPOT  00409 
VELPOT  00410 
VELPOT  00411 
VELPOT  00412 
VELPOT  00413 
VELPOT  00414 
VELPOT  00415 
VELPOF  00416 
VELPOT  00417 
VELPOT  00418 
VELPOT  00419 
VELPOT  00420 
VELPOT  00421 
VELPOT  00422 
VELPOT  00423 
VELPOT  00424 
VELPOT  00425 
VELPOT  00426 
VELFOT  00427 
VELPOT  00428 
VELFOT  00429 


r>  ri  r>  n  n 


IF  (YBAR  .CE.  0)  CO  TO  650 

VELPOT 

0043o 

JCOLR  =  JBAR  ♦  NUBAR  ••  HUA1C2  ♦  1 

VBLPOT 

00*31 

CO  TO  660 

VELPOT 

00*32 

MO  JCCLfi  =JBAR  -  Nl*AR  ♦  MUAIC1  -  1 

VELPOT 

00*33 

660  CONTINUE 

VELPOT 

00434 

c 

VELPOT 

00435 

c 

LOOP  ON  A  ROW  OF  WINC  BOXES,  COMPUTING  RIGHT  HA  Hi  WING-TAIL 

VELPOT 

00*36 

c 

CONTRIBUTIONS 

VELPOT 

00437 

DO  660  HUAI  =  MUA,C1,HUAIC2 

VELPOT 

00438 

IF  (JCOLR  .LE.  0)  CO  TO  670 

VELPOT 

00*39 

CALL  DCOCERdBOXW.LBXCCW,  I.JCCLR,  I. JCOLR,  .F.,  ICC) 

VELPOT 

00440 

IF  (ICD  .EQ.  0)  GO  T  O  670 

VELPOT 

00441 

c 

A  CONTRIBUTING  BOX  HAS  BEEN  FOUND.  GET  THE  AIC  LOCATION 

VELPOT 

00442 

KA1C  =  I AIC  ♦  HUAI 

VELPOT 

00443 

c 

GET  THE  NORMAL-WASH  LOCATION 

VELPOT 

00444 

IDS  =  LOCSCWt  I,  JCOLR,  IPNTEW.LPNTLW,  1,  LFWTDW) 

VELPOT 

00445 

c 

ADD  THIS  CCNTF.IBUTION  TO  N-HAT 

VELPOT 

00446 

IF  (II  ,B8.  2)  CO  TO  665 

VELPOT 

00447 

emhawouceht)  =  (ccstPsmn^wouuo  -  sin(Psicif)*v(kaio) 

VELPOT 

00448 

I  *  E7RUS CCS)  ♦  EmURWUUCENT) 

VELPOT 

00449 

CO  TO  670 

VELPOT 

00490 

663  CONTINUE 

VELPOT 

00451 

EN5iJF.W(JUCEW)  =  CCS  (PSIDIF)  4W0GA1C)  *  ENRUS(ltS)  ♦ 

VELPOT 

00452 

\  EmLRW(JUCENT) 

VELPOT 

00453 

6TO  CONTI HUE 

VELPOT 

00454 

JCOLR  =  JCCLfi  ♦  JINK 

VELPOT 

00455 

6B0  CONTINUE 

VELTOT 

00456 

c 

Off)  OF  LOOP  FCR  RICHT  WINC  ROW  CONTRIBUTION 

VELPOT 

00457 

c 

VELPOT 

00458 

655  CONTINUE 

VELPOT 

00459 

t  *  i  *  I 

VELPOT 

00460 

IF  «  .LE.  0)  CO  TO  700 

VELPOT 

00461 

IAIC  =  I AIC  ♦  INCAIC 

VELPOT 

00462 

INCAIC  =  INCAIC  ♦  2 

VELPOT 

00463 

690  CONTINUE 

VELPOT 

00464 

c 

E>«  CF  LOOP  FORWARD  ON  RCVG-  TO  COMPUTE  RIGHT  WING  OUT-OF- 

VELPOT 

00465 

c 

PLANE  EFFECTS  ON  THE  TAIL,  FROM  6*0 

VELPOT 

00466 

c 

VELPOT 

00467 

c 

DETER  MI  tC  VH  ETHER  LEFT  WING  IfFLUENCE  IS  TO  3E  COMPUTED 

VELPOT 

00468 

700  CONTINUE 

VELPOT 

CU469 

IV  (STM  .EQ .  0)  CO  TO  BOO 

'•EL  POT 

00470 

e 

GET  AIC  ARRAVS  W  AH)  V  (05  LEFT  WINC  INFLUENCE  ON  TAIL 

vaPCT 

00471 

It  =  1 

VELPOT 

00472 

IF  (  -PSIW  .EW.  PSIT)  I?  =  2 

vapor 

00473 

CALL  CCTAIC < JUCENT ,  LWT,  II,  IR) 

vapor 

00474 

IF  (IR  .NE.  0)  CO  TO  600 

va*jr 

00475 

MJ6MIN  =  ABS(a>  4  .5 

vapor 

004V6 

NJBHA‘<  =  IUCENT  -  1 

vapor 

00477 

I  s  IUCENT  -  HUBHlu 

vapor 

00478 

YWU6A*  *  -  CCMPSIW  4  PSIT) •(JUCtW-.S)  4  OAPL*StN(PS!W> 

vapor 

004  T9 

JBAR  *  Y*9M 

vtL°or 

00480 

IF  (YMU6AR  .CC.  C)  iBAR  =  JBAR  ♦  I 

vapor 

CO  481 

IF  (YBAR)  T20,’25,T3C 

vapor 

00482 

720  JINCR  =  I 

vapor 

00483 

CO  TO  735 

VEl.POT 

00484 

725  IAIC  a  NUBMIN4*2 

VELPOT 

00485 

INCAIC  =  24NJCMIN  4  t 

VClPcT 

00«tfS 

3141 


jinch  =  -l 

VELPOT 

00487 

CO  TO  740 

VELPOT 

CKM88 

no 

<r* 

1 

II 

5 

VELPOT 

00489 

ns 

IAIC  *  NUBNIWF42  ♦  NUBMIM 

vapor 

00490 

INCAIC  =  24NUBMIN  ♦  2 

vapor 

00491 

740  CONTINUE 

vapor 

00492 

c 

vapor 

G9493 

c 

LOOP  FORWARD  TO  GET  LEFT  WING  CONTRIBUTION  TO  THE  TAIL 

vapeT 

00494 

IF  <SYN  .EH.  0 1  CO  TO  SCO 

vapor 

00495 

DO  790  NUBAR  =  NJBKI N,  MX  MAX 

VD,POT 

00496 

MUAIC1  =  MUAICtl  ,NU8AR+i) 

vapor 

00497 

HUAIC2  =  HUAIC12,NUBARn) 

vaPOT 

00496 

IF  (MUAIC2  .LE.  0)  CO  TO  785 

vapor 

00499 

IF  CYBAR  .CE.  0)  CO  TO  750 

varor 

00500 

JCCLL  =  JBAR  -  NUBAR  ♦  MUAIC1  -  1 

vapor 

00501 

CO  TO  760 

vapor 

00502 

750 

JCCLL  =  JBAR  <  NUBAR  -  HUAI Cl  +  1 

vapor 

00503 

760  CONTI  NIC 

vapor 

00504 

c 

vapor 

00505 

c 

LOOP  ON  LEFT  WING.  ROW  TO  GET  LEFT  WING  CONTRIBUTION  TO  TAIL 

vapor 

00506 

DO  780  HUAI  =  MUAIC1 .MUAIC2 

VELPOT 

00507 

IF  (JCOLl  .LE.  0)  CO  TO  77D 

VELFOT 

00508 

CALL  DCOCER<IBOXW,LBXCCW,  I, JCCLL,  I. JCCLL,  .F.,  ICC) 

VELPOT 

1X1509 

IF  (I CD  .EH.  O'  CO  TO  770 

VELPOT 

00510 

c 

A  CONTRIBUTING  BOX  HAS  BEEN  FOUND.  GET  THE  AIC  LOCATION 

•vapor 

00511 

MIC  =  IAIC  ♦  HUAI 

vapor 

00512 

c 

GET  THE  NORMAL  WISH  LOCATION 

vapor 

00513 

ICS  =  LOCSCWl  I,  JCCLL,  IPNTI>‘  LPNTCW,  1,  LPNTCW) 

vapor 

OD5U 

c 

ACC  THIS  CONTRIBUTION  TO  N-HAT 

vapor 

00515 

IF  <11  .EB.  2)  CO  TO  765 

varor 

00516 

E7RULW( JUCENT1  =  (CPSISmW(MIC)  -  SPS!SM*V(KAIC)  ) 

vapor 

00517 

1 

l  *  O*  US  (ICS)  ♦  ENtULW(JUCENT) 

vapor 

00518 

CO  TO  770 

vapor 

00519 

765 

CONTINUE 

vapor 

00520 

ENtULWUUCENi »  =  CPSISMAWIKAIC)  *  ENRUSIICS)  ♦  ENRULW(JUCENT) 

VaFOT 

00521 

770 

CONTINUE 

vaPOT 

00522 

JCCLL  =  JCCLL  ♦  JINCR 

vapor 

00523 

780 

CONTINUE 

VaFOT 

00524 

c 

ETC  Or  LOOP  FOR  LFFT  WING  ROW  CONTRIBUTIONS 

vapor 

00525 

c 

vaPOT 

00526 

785 

CONTINUE 

vapor 

00527 

I  =  1-1 

vaPOT 

00528 

IF  <1  .LE.  0)  CO  TO  800 

vaPOT 

00529 

IAIC  -  IAIC  ♦  INCAIC 

vap-T 

0C530 

INCAIC  =  INCAIC  ♦  2 

vapm 

00531 

790 

CONTINUE 

vaPOT 

00532 

c 

END  <X  LOOP  "CRWfRC  ON  ROWS,  TO  COMPUTE  LEFT  WING  OUT -OF- PLATE 

VELPOT 

00533 

L 

EFFECTS  ON  THE  TAIL,  FROM  740 

VE1.POT 

0053-, 

c 

VELPOT 

00535 

IF  <SVM  .LV.  0)  ENULWIJUCENT)  =  -  ENRULWOUCENT) 

vapor 

00536 

300 

CONTINUE 

vaPOT 

CO  53  7 

c 

vapor 

00138 

c 

-  ----  ----------------- 

vapor 

00539 

c 

vaPOT 

CO  540 

< 

COMPUTE  TWC  UNSUBCIVIDED  KCRmt.  WASH  VALUES,  IF  THE  BOX  IS  ON- 

vaPOT 

00541 

c 

PLATFORM.  JF  not,  GET  THE  VALUE  FRCM  THE  INTERFERENCE  TERMS 

VELPOT 

00542 

r 

ATC  THE  CONCH  ION  THAT  DELTA-PHI  =  0  CN  ANT  DIAPHRAGM,  MCCIF1- 

VELPOT 

00543 

BM2 


c 

c 

c 


c 


c 


EC  BY  WAKE  EFFECTS  WHERE  APPLICABLE.  VELPOT 

VELPOT 

-  vail  -  vapor 

•10  CONTINUE  VELFOr 

IF  (NCCROK  .NE.  1)  CO  TO  8 GO  VELPOT 

CCT  DEFLECTION  ANC  SLOFE  OF  UNSUBCIVIDEC  TAIL  BOX  CENTER  VELPOT 

ICS  =  LOCSCWMPCENmCNLP,  JUCENT, I PNTRH,  LMCCCStl iLHOCES)  VELPOT 

DFL  =  DEFSL(l.IDS)  VELPOT 

SLP  =  CEFSLUMDS)  VELPOT 

COMPUTE  TAIL  NORMAL  WASH  VALUES  VELPOV 

EJCIF  =  2.0 *(  CVFLXIBlPSLP,  >KVL*CFL>  -  E1R  UR  W(  JUCENT)  VELPOT 

t  -  ORULW;  JUCENT)  )  ♦  ETRLLL  (JUCENT)  -ETRULU( JUCENT)  '/EL POT 

EteUM  =  -  (EMiLLL (JUCENT)  +  E)RULU(  JUCENT)  )  VELPOT 


c  vapor 

TF  (NCCCEN  ,tc,  1)  CO  TO  8K  vaPOT 

LOCNU  =  LOCSnwauCENT+ICVLPN,  JCTO/T,  IPNTDW,  LPNTDW,  1  .LPNTDW)  VELPOT 
ORU5(LCCT*/)  =  0.5* (ENSUM  +  ETCIF)  VaPOT 

ENRlS (LOCWO  =  0.5*  (ENSUM  -  CNDIF)  vaPOT 

co  to  850  vapor 

c  vapor 

c  -  wing  -  vapor 

sac  continue  vapor 

IF  (NCCBCK  .TC.  1)  CO  TO  860  VaPOT 

C  GET  DEFLFCTION  AND  SLOPE  of  utgubdi VICED  WING  BOX  CENTER  vaPOT 

IDS  =  LOCSCWdTXENT,  JUCENT,  IPNTRM,  LMCCES.l .LMCCES)  VaPOT 

oa  =  cefsl(i  i  ids)  vapor 

slp  =  defsl(2i  ics)  vapor 

C  COMPUTE  WING  NCKKAL  WASH  VALUES  VaPOT 

EN5UM  ;  -QRULU(JUCENT)  -  ETRaL (JUCENT)  vaPOT 

OCIF  =  EN5UM  ♦  (CMPLX(B1«SLP,  XXVL*Da>  ♦  ETRaL  (JUCENT) )  *  2.0  vaFOT 
C  VaPOT 

IF  (I PCEUT  .TC.  IUCENT)  CO  TO  852  VaPOT 

LOCNW  =  LOCSDWUUCENT,  JUCENT,  IPNTDW,  LPNTDW,  1,  LPNTCW)  VaPOT 

ETRUS  (LOCT*/)  =  (ENSUM  +  ETCIF)  *  0.5  VaPOT 

QRt_S(LOO*/>  =  (ENSUM  -  EUC1F)  *  0.5  VaPOT 


C 

C 


C 


c 

c 


vapor 


NORMAL-WASH  IS  AVAILABLE  IF  THE  BOX  IS  CN-PUhFCRM  VaPOT 

840  CCNTIM*  vaPOT 

IF  ( .N.  FBOO  LOCNW  =  LCOSCWUUCENT+ICVLPN,  JUCENT,  IPNTDW, LPNTDW,  VaPOT 
1  1,  LPNTDW)  '/a  POT 

IF  (SUB OFF)  CO  TO  855  VaPOT 

GET  THE  SUCCI VICED  VALUE  FCR  THE  NORMAL  WASH  TERMS  VaPOT 

taPHA  =  OR  US  (LOCNW)  VEl.POT 

IF  (Da (VIA  .Efl.  XIN1T*  CO  TO  830  VaPOT 

CCLW8  -  ORLS  (LOCW/J  vaPOT 

00  TO  854  VaPOT 

THE  TEXT  2  STATEMENTS  ARE  CTLY  HIT  FCR  A  SUBDIVIDED  PLATFCRM  'EL POT 

BOK  WITH  HO  ASSOCIATED  PLA^FCTxM  CCNTRCL  POINT  VaPOT 

052  CONTINUE  vaPOT 

FULBX(JUCENT)  x  .FALSE.  VaPOT 

OCLPHA  *  (ENSUM  ♦  ENDIF)  *  0.5  VELPOT 

ICLTWB  *  (ENSUM  -  ETCIF)  «  0.5  VELPOT 

854  CONTINUE  va**OT 

CNSRUS  s  CMPLX(  REAL(0aPHA)/X3U3DV,  AIMAC(oaPHA)/XSUSDV  ♦  vaPOT 

I  XXVL*(IROW-I!CCNT)*REAL(DaPHA)  )  VELPOT 

CNSAL5  =  CMPLXt  REAL  (DEL PHD) /MUDDV,  AI MAG(0a*(B> /XSUBCV  ♦  VaPOT 

I  XXVL*(!fiOW-lICENT)  W<CAL (DEIWB)  )  vaPOT 


00544 
00545 
00546 
00547 
00548 
00549 
00550 
00551 
00552 
00553 
00554 
00555 
00556 
0C557 
00558 
00559 
00560 
00561 
00562 
00563 
00564 
00565 
00566 
00567 
00568 
00569 
00570 
00571 
00572 
00573 
00574 
00575 
00576 
00577 
00578 
00579 
00580 
00581 
CO  581 
0CS83 
CCI584 
COSOS 
00586 
00587 
00588 
00589 
005*0 
00591 
00592 
00593 
00594 
00595 
00596 
00597 
00598 
00599 
00600 
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tF  (CBOX)  CO  TO  8 TO 
CO  TO  1030 
•S3  CONTINUE 

E*«RUS  =  EMRUS  (LOCNW) 

E»RLS  -  ENRLS  (LOCNW) 

CO  TO  8  TO 
880  CONTINUE 

FULLBX(JUCENT)  =  .F. 

C 

C  ---------------------- 

C 

C  DETERMINE  THE  VELOCITY  POTENTIAL  CONTRIBUTIONS  TRCM 

C  HOKES  LVINC  AHEAD  OF  THE  CURRENT  BOX 

C 

CTO  CONTINUE 

JF  («*$I3  .«.  0  .ATE).  DIMS)  CO  TO  880 
C  THE  SURFACE  13  FLANMR.  GET  FULL  SURFACE  CONTRIBUTIONS 

DELPH  =  BdROW,  JCCL,  H(3RN-,SKERN_,  IBOX.LBXCD,  WING,  ,F.  ) 

CO  TO  890 
C 

C  DIHEDRAL  ANCLE  IS  TO  BE  ACCOUNTED  FCR.  GET  THE  FLANAR 

C  (SUBDIVIDED)  CONTRIBUTION  CF  THE  RIGHT  SURFACE 

880  CONTINUE 

DELHI  =  B UROL  JCCLi  PKERN_,SKEJRH.,  IBOX.LBXCD,  WING,  .T.  ) 

C  ADD  THE  SPATIAL  LEFT  SURFACE  CONTRIBUTIONS 

DELHI  =  DELHI  ♦  CHIIL(JUCENT) 

890  CONTINUE 

IF  (NCBBCK  -  2)  910,1000,980 
C 
c 

c 

C  THE  BOK  is  ON- FLA Tf CRM,  CENTER.  COMPLETE  THE  CALCULATION  OF 

C  1!IE  VELOCITY  POTENT  I AL 

C 

910  CONTINUE 

ICS  "  LCCSDWUUCENT^ICWLF,  JUCENT,  IFNTRM.LMCCES,  1,  LHOCES) 

IF  (SUB OFF)  GO  TO  915 

DELPHI  (ICS>  =  (ENSRUS -ENSRLS)  *  SKERN.(t)  ♦  DELHI 
CO  TO  920 
915  CONTINUE 

DELPHI  (ICS)  =  (ENSRUS-ENSRLS)  F*ERN.d>  ♦  DELHI 
9 EO  CONTINUE 
C 

C  COMPUTE  AW  TRAILING  EDGE  VELOCITY  POTENTIALS  ASSOCIATED 

C  WITH  THU  URblAMViCED  BOX  , 

C 

C  IS  THIS  A  TRAILING  EDGE  BOX  - 

IF  (.NOT.  CC5LAH)  CO  TO  930 

IF  (TEXLCCOEXLOO  .!.T.  FUROO  JEXLOC  =  JES.OC  ♦  WESW 
IF  I  FEW.  OC  (JEXLOC)  .CT.  FLIRQW)  JEXLOC  =  JEXLOT  -,WBSW 
910  CONTINUE 

JJ  =  JOR.OC  -  MSU6D2 
TX'-MIN  x  TtXLOC(JJ) 

(F  (NBU6CV  .Efl.  1)  GO  TO  933 
DO  932  J  -  2  ,NSUBDV 
JJ  =  JJ  ♦  1 

TEXMIN  r  AMI  N1  '.TC’XM!  K,  TEX1.0C  ( J  J) ) 


VELPOr 

00  €01 

VFLPOT 

00602 

VELPOT 

00603 

vapor 

00604 

velpcx 

00605 

vapor 

00606 

vapor 

00607 

vapor 

00638 

vapor 

00609 

vapor 

00610 

vapor 

00611 

vaK» 

00612 

vapor 

00613 

vapor 

00614 

vapor 

00613 

vapor 

00616 

VELPOT 

00617 

vapor 

00618 

vapor 

00619 

vapor 

00620 

vapor 

00621 

vapor 

00622 

vapor 

0062? 

VELPOT 

00624 

vapor 

00623 

vapor 

00626 

VELPOT 

00627 

vapor 

00628 

vapor 

0062S 

vapor 

00 630 

varor 

00631 

VELPOT 

00632 

vapor 

00633 

vapor 

DO  634 

vapor 

00635 

vapor 

00636 

vapor 

00637 

varor 

00633 

VELPOT 

00639 

vapor 

00640 

VELFOT 

00641 

varor 

00642 

VELPOT 

00643 

VELPOT 

00644 

vapor 

1X1645 

vapor 

00646 

vapor 

00647 

vapor 

00648 

vapor 

00649 

vapor 

00650 

VELPOT 

00651 

VELPOT 

00652 

vapor 

00653 

VELPOT 

00654 

VELPOT 

00655 

VELFOT 

00656 

VELPOT 

0C65T 
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932  CONTINUE 

933  IF  <  TEXMIN  .CF..  FLIRCH  ♦  XSUBDV)  CO  TO  1030 

C  YES.  CET  THE  BASIC  VELOCITY  POTENTIAL 

DEL«HB  -  DELPHI  (IDS) 

C  TEST  UNSUBDI  VICED  BOX  AHEAC  OF  CURRENT  ONE  * 

CALL  DCOOERIIBOX.LBXCD,  IROW-76UBDV,  JCCL,  IRCV8N5UBDV,  JCCL, 

1  .T.,  NCDA) 

IF  (NCDA  .PC.  1)  GO  TO  940 
C  IT  IS  ON  PLANrdM.  TEST  FCS  TIP  CHORD  - 

IF  (  JEX.OC  ,B5.  JCCL  .AND.  JUCENT  .LT.  NT BW)  CO  TO  950 
IF  (  JEW.OC  .67.  JCCL  .AMI.  JUCENT  .LT.  NTBT)  CO  TO  950 
C  BOX  IS  ON  THE  TIP  OH  CRD.  CHECK  FCR  THIRD  TIP  BOX  - 

IR  =  IRON  -  2*NSUECV 
IF  1  IR  .LT.  IXB)  GO  TO  940 

CAIL  CCCCER  (IBOXiLBXCDi  IR,  JCa.  IR.JCCL,  .T'.,  NCDC) 

IF  (NCDC  .BO.  1)  CO  TO  950 

C  TRY  MACH  RAY  EXTRAPOLATION.  ARE  THE  2  RAY  BOXES  ON-FLAMCRM  - 

940  CONTINUE 

X  =  JCCL  -  T61SDV 

CALL  DCOKRCIBOX.LBXCD,  IROW.JC,  IRCV.JC,  .T.,  NCDC) 

IF  (NCDC  .PC.  1)  CO  TO  945 

X  =  JC  -  PC.UDDV 

CALL  DCOLEMIBGX.LBXCD,  IROW-P6UBDV,  JC,  IRON-NSUBDV, JC,  .T..PEDC) 
IF  (NCDD  .PC.  1)  CO  TO  945 
C 

C  MACH  RAY  EXTRAPOLATION,  FOLLOWED  BY  OKRDWISE  LINEAR  EXTRA - 

C  PCLATICN 

ICtHPC  =  LGCSDVHC  IUCENT-1+ICM.P,  JUCENT-2 ,  IPNTRM.LMCCES.l  ,1  MCT.ES) 
IDPHW  =  LOCSCW1  lUCENT+fCWLF,  JUCENT-1 ,  IFNTRM,LMCCES,1  clMCCES> 
E€L*HA  -  DELPHI  (IDFHve) 

DELPHC  =  DELPHI  (I CIHMl)  » 

SDELPH  =  (2.0*DELPHC  -  CELPHA  -  DELPHB)  .'XSUBDV 
CO  TO  955 
C 

C  MACH  RAY  UNAVAILABLE,  ARE  THERE  H  BOXES  CN  THE  CHORD  - 

945  IF  (NCSA  .PC.  1)  CO  TO  3020 

C 

C  CHORDWISE  LINEAR  EXTRA PCLATICN 

C 

930  CONTINUE 

ItPHVtt  =  LOCSDVKIUCENT-l+ICVLP,  JUCENT,  IPHTRH.LMCCES,  1.LMCCE5) 
ttCLPH  =  (DELPHB  -  DELPHI  (I CPHM1  >  VXSUPDV 
C 

c  LOOP  TO  COMPUTE  AND  STORE  TRAILING  EDGE  VELOCITY  POlENTIALS 

935  CONTINUE 

JA  JEXLOC  -  NSUBD2 
.*?  -  JEX.CC  *  NSUBC2 
ro  930  JJ  s  JA.JB 

XI  NCR  *  TEW.OCMJ)  -  I  ROW 

IF  (XT NCR  .LT,  -XSU8DVC2.0)  CO  TO  960 
TVP(JJ)  x  DELPHB  ♦  XINLR4SDELPH 
•fiO  CONTINUE 

C  ALL  TRAILINC  CDCC  VALUES  HAVE  BEEN  COMPUTED  F(R  no$ 

C  UNSUBDl  Vi  DID  BOX. 

CO  TO  1030 


VELPOT 

00658 

VELPOT 

00659 

VELPOT 

0C6G0 

VELPOT 

00661 

VELPOT 

00662 

VELPOT 

0GS63 

VELPOT 

00664 

VELPOT 

00665 

VELPOT 

00666 

VELPOT 

0066? 

VELPOT 

00668 

VELPOT 

00669 

VELPOT 

00670 

VQ.FOT 

00671 

VELPOT 

00672 

VELPOT 

00673 

VELPOT 

00674 

VELPOT 

00675 

VELPOT 

00676 

VELPOT 

00677 

VELPOT 

0067p 

VELPOT 

00679 

VELPOT 

00680 

VELPOT 

00681 

VELPOT 

00682 

VELPOT 

00663 

VELPOT 

00684 

VELPOT 

00665 

VELPOT 

00686 

VELPOT 

00687 

VELPOT 

00688 

VELPOT 

00689 

VELPOT 

00690 

VELPOT 

00691 

VELPOT 

0069? 

VELPOT 

00693 

VELPOT 

00694 

VELPOT 

00695 

VELPOT 

00696 

VELPCT 

00697 

VELPOT 

00698 

VELPOT 

00699 

VELPOT 

00700 

VELPOT 

00?0l 

VELPOT 

00702 

VELPOT 

00703 

VELPOT 

00/04 

VELPOT 

00705 

VELPOT 

00  >06 

VELPOT 

00707 

VELPOT 

00708 

VELPOT 

00709 

VELPOT 

00710 

VELPOT 

00?lt 

VELPOT 

00712 

VELPOT 

007t  J 

VELPOT 

00714 

C 

C 


c 

VELPOf 

00715 

c 

It  OK  IS  IN  THE  TRAIL!  NO  EDGE  BUFHRACm  AREA.  COMPUTE  THE  HAKE 

VELPOT 

00716 

c 

VELOCITY  POTENTIAL  CONTRIBUTION 

VELPOT 

0071 7 

9*0  CONTINUE 

velpot 

00718 

IF  (COPLAN)  GO  TO  985 

VELPOT 

00719 

J t  ~  JOa.GC 

VELFOT 

0C.72C 

GO  TO  990 

VELPOT 

00721 

90S 

JJ  *  JCCL 

VELPOT 

00722 

IF  (JJ  .GT.  MYBST)  GO  TO  990 

VELPOT 

00723 

JJ?  =  JJ  ♦  MTBSW 

VELPOT 

00724 

IF  (FLOAT (IRON)  .GT,  TEXLOC(JJT)  )  JJ  =  JJT 

VELPOT 

00725 

990 

CONTINUE 

VELPOT 

00726 

c 

COMPUTE  (X-DISTAKE/B1)  *  K1 

VELPOT 

00727 

XBKVL  =  (FLOAT (IRCVD-TEXLCC  (JJ)  )  s  X(VL/XSUBCV 

VELPOT 

00723 

AZERO  i  TVP(JJ)  *  CMPLX(  CCS(XDKVL)  ,  -SlNtXEKVU  ) 

VELPOT 

00729 

IF  C,NOT.  CBCX)  GO  TO  1010 

VELPOT 

00730 

IF  (IUCENTtICNLP  .GT.  NPNTRS5  GO  TO  1010 

VELPOT 

00731 

c 

SET  DEL  (HI  VALUE  TO  ZERO,  TO  CLEAN  UP  LEFT  OVER  MODE  SHAPES 

VELPOT 

00732 

I  =  LOCSCWUUCENTMCWLP.  JUCENT,  I PNTRM,  LMCCES.l  .L'MCCES) 

VELPOT 

00733 

IF  (I  .NE.  0)  DELPHI  (i)  =  (0.,0.) 

VELPOT 

00734 

GO  TO  1010 

VELPOT 

IX)  735 

c 

VELPOT 

00736 

c 

BOX  IS  IN  A  LEADING  EDGE  CR  TJP  DIAFHrACM  AREA 

velfot 

00737 

1000 

CONTINUE 

VO.  POT 

00738 

AZEKO  =  (0.,0.) 

VELPOT 

00739 

c 

VELPOT' 

00740 

c 

CONFUTE  NCKMAL-HASH  VALUES  FOR  A  (SUBDIVIDED)  DIAPHRAGM  BOX 

VELPOT 

00741 

c 

VELPOT 

00742 

o 

++ 

o 

** 

CONTINUE 

VELPOT 

00743 

IF  (SUBOFF)  CO  TO  1015 

VELPOT 

00744 

ETCIF  (AZEKO-  DELPHI/  SKFRf*.(l! 

VELPOT 

00745 

EJCUM  =  -  (ENEULUOUCENT)  ♦  EfRLLL  (JUCENI )  ) 

VELPOT 

00746 

CrJSUM  r  CMFLX(r.EAl.(£NSUM;  ,  A I  ‘••A  G  (EtCUM)  ♦  «KVL*XSUBDV*(IRaW  - 

VELFOT 

00747 

1 

L  ICENT)  AREAL  (EICON)  )  /  XSUDDV 

VELPOT 

00748 

CO  TO  1020 

VELPOT 

00749 

1015 

CON1 1 NUE 

VELPOT 

00750 

EfCIF  =  (AZERO  -  DEL  PH)/  PKEKN.  >i ) 

VELPOT 

00751 

ENSIM  =  -  (ENiULUI  JUCFNT)  ♦  EIRLLL  ( .'UCEVT)  ) 

VELPOT 

0075? 

c 

VELPOT 

00753 

1020 

CONTI  MX' 

VO.POT 

00754 

FNSRUR  0.5*(ENSUM  ♦  rCIF) 

VO  POT 

00755 

ENSRIS  =  0.5*(ENSUM  -  ENCIF) 

VELPOT 

00756 

IF  (SUBCFF)  GO  VO  1090 

VELPOT 

00757 

IO  TO  1055 

VELPOT 

00756 

c 

1 

VELPvjT 

00759 

c 

. \ . 

VELPOT 

00760 

c 

I 

VELPOT 

00761 

c 

STCRE  THE  ICR  MAI  HASH  VALLES 

VELPOT 

00762 

c 

VELPOT 

00763 

1050 

CONTINUE 

VELPOT 

00764 

I?  (SUB OFF)  CO  TO  1100 

VELPOT 

00765 

r 

VELPOT 

00T6C 

c 

STORE  THE  COMPUTED  SUBDIVIDED  NORMAL  HASHES 

VELPOT 

00767 

1055 

CONTINUE 

VELPOT 

00768 

CALL  ST06DV  (IROW.jCOL,  EN3BD,  IBOX.LBXCC,  IXBS.MXBS.KIBBS.IRR) 

VELPOT 

00769 

IK  URR  .PC .  0>  GO  TO  J050 

VELPOT 

007  70 

1 F  (.NOT.  LCOX)  GO  TO  1100 

vaPOT 

00771 
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c 

c  oeterhirc  the  unsubdi  viced  ncrmal  wash  values 

1040  IE  TNCCCEN  -  1)  1100,1050,1060 
C  IE  THE  EC*  IS  COMPLETE,  THE  VALUE  IS  ALREADY  STORED  - 

1010  IE  <FU_LBX(JUCENT>>  GO  TO  1100 
C  THE  UNSUBOl VICED  VALUE  EQUALS  THE  AVERAGE  OF  ALL  ITS 

C  SUBDIVIDED  BOXES 

1000  CONTINUE 

II  =  I CENT  -  N5U6D2 
JJ.J  =  JCENT  ♦  N5U8D2 
ENSRUS  -  (Q.,0.) 

OBRLS  =  (0.,0.i 
DO  1060  I  s  l.NSUBCV 
JJ  -  JCENT  -  N3UBC2 

CALL  DCCTOaiBOX.LBXCD,  II.JJ,  II.JJJ,  .T.,  1CCCE  ) 

DO  107S  J  =  l.NSUBDV 
IE  IICCCEIJ)  „ES.  0)  GO  TO  1070 

LOCDW  a  LOCSCWt  II.JJ,  IFNTSC.IPNTIN,  IPNTOT,  IPNTLS) 

ENSRUS  s  ENSUED  (1 ,  LOCDW)  ♦  ENSRUS 
EMSRLS  --  ENSUBD(2,L0CCW)  +  ENSRUS 
1070  CONTINUE 

JJ  =  JJ  ♦  1 
1075  CONTINUE 
II  *  II  ♦  I 
1060  CONTINUE 

ENSRUS  =  EJBRUS/XSUBCV 
D6RUS  -  ENSRLS/XSUBOV 
C 

C  RESTORE  THE  PARTIAL  BOX  FLAG  FOR  THE  NEXT  ROW 

KULBXCJUCENT)  =  -T. 

C 

C  STCRE  THE  UT6UBDI  VICED  NCR  HAL  WASTES 

1030  CONTINUE 

LOCMW  =  LOCSCWt  IUCENTV-ICNLPN,  JUCENT,  IFNTCW,  LPNTCW.l  .LPNTCW  ) 

IP  (LOCNW  ,EB.  0  )  GO  TO  3040 

ORUSILCCNW)  =  ENSRUS 

IF  OWING)  CO  TO  1095 

EN5LS  (LOCMW  )  =  ENSRUS 

GO  TO  1100 

1095  EHiLStLOCNW)  =  ENSRUS 
1100  CONTINUE 

JEXLOC  -  JEXLOC  ♦  1 
C 
C 

1200  CONTINUE 

C  EM)  OF  LOOP  ON  (SUBDIVIDED)  CHORDS,  STARTING  AT  355* 


130C  CONTINUE 

Ttit  OF  LOOP  ON  (SUB Cl VI CCD)  ROW), 


STARTING  AT  1 20 


RCTVHM 

C 

r  ----------- 

C 

C  DIAGNOSTICS  -  ALL  CALL  FU*" 


VELPOT 

00772 

VELPO? 

00773 

VELPOT 

00774 

VELPOT 

00775 

VELPOT 

00776 

VELPOT 

00777 

VELPOT 

00778 

VELPOT 

00779 

VELPOT 

00780 

VELPOT 

00781 

VELPOT 

00732 

VELPOT 

00783 

VELPOT 

00784 

VELPOT 

00785 

VELPOT 

00786 

VELPOT 

00787 

VELPOT 

00788 

VELPOT 

0C7C9 

VELPOT 

00790 

VELPOT 

00791 

VELPOT 

00792 

VELPOT 

00793 

VELPOT 

00794 

VELPOT 

00795 

VELPOT 

00796 

VELPOT 

00797 

VELPOT 

00798 

VELPOT 

00799 

VELFOT 

00800 

VE1.FOT 

00801 

VELPOT 

00802 

VELPOT 

00803 

VELPOT 

00804 

VELPOT 

00805 

VELPOT 

0080$ 

VELPOT 

00807 

VELPOT 

00808 

VELPOT 

00809 

VELPOT 

00810 

VELPOT 

00811 

VELPOT 

00012 

VELPOT 

00813 

VELPOT 

00814 

VELPOT 

00815 

VELPOT 

008 1G 

VELPOT 

00817 

VELPOT 

00818 

VELPOT 

00619 

VELPOT 

00820 

VELPOT 

00821 

VELPOT 

00622 

VELPOT 

00823 

VELPOT 

00824 

VELPOt 

00825 

VELPOT 

00826 

vapor 

0C827 

vara 

00828 
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C  VB.PCT 

3010  VR1TE  <NTo, 9010)  VELPOT 

W<!TE  (NTS, 9999)  IRCW.JCO.,  IUCENT,  JUCENT  VELPOT 

CO  TO  420  VELPOT 

3020  W-ITE  (NTS, 9020)  VELPOT 

CO  TO  3999  VELPOT 

3030  <45 1  TO  (W6.9030)  VELPOT 

CO  TO  3999  VELPOT 

3040  WUTE  (NY6,9040>  VELPOT 

CO  TO  3999  VELPOT 

C  VELPOt 

3999  M5ITE  (NTS, 9999)  IRON.JCCL,  IUCENT,  .JUCENT  VELPOT 

CALL  PLUSH  (1)  VELPOT 

C  '  VELPOT 

C  VELPOT 

9010  FCRMAT  (56HG***  WARNING  -  NO  FLANFCRM  CONTCO.  PM  NT  FCJUTC  FOr.  SUBDI  VELPOT 
1  52HVICED  BOX  CURING  VELOCITY  POTENTIAL  CALCULATIONS  ***  )  VELPOT 

9020  FCRMAT (56H0***  ERROR  -  THE  TIP  BOX  PATTERN  COES  NOT  ALLOW  TRAILING  VELPOT 
1  44H  ECCC  VELOCITY  POTENTIALS  TO  BE  COMPUTED  ***  )  VELPOT 

9030  FORMAT (56H0***  ERROR  -  FAILURE  IN  STORING  SUBDIVIDED  NORMAL-WASHES  VELPOT 
1  4H  «♦  )  VELPOT 

9040  FCRMAT  <53HO***  ERROR  -  FAILURE  IN  STORING  CONTROL  PM  NT  NORMAL-  VOLPOT 
1  10HWASHE5  ***  )  VELPOT 

9999  FCRMAT (14X,  16HSUDDI  VICED  BOX  ( ,  13, 1H,  13, 19H)  ,  CONTROL  POINT  (,  VELPOT 
1  12, 1H, 12, 1H)  )  VELPOT 

C  VELPOT 

EH)  VELPOT 


00329 
COB  30 
00831 
00832 
00833 
00834 
00835 
00836 
00637 
00836 
00839 
00840 
00841 
00842 
00843 
00644 
00845 
00846 
00847 
00848 
00849 
00850 
00851 
00852 
00853 
00854 
00855 
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A  A 


COMPLEX  FUNCTION  B  (IROW.JCCL,  PKERH.  ,SKEAN_ ,  IBOK.LBXCD,  B 

1  WJNC,,  DIH)  B 

B 

CCM*VTE3  B  =  SUM  OVER  NUIS'JM  CMS  MU (( DONNISH) * (KERNEL)  )  )  B 

(MU, MU  .N£.  0)  3 

8  IS  USED  TO  COMPUTE  VELOCITY  POTENTIALS  CF  ON-  B 

flJANFCRM  BOXES,  Cfi  DCWUASHES  CF  DI AFHRAGM  BOXES  B 

B 

PARAMETERS  -  8 

IRON  =  ROW  LOCATION  CF  BOX  FOR  WHICH  B  IS  TO  BE  B 

COMPUTED  B 

JCa.  =  COLUMN  LOCATION  OF  BOX  B 

**ERM  =  PRIMARY  KERNEL  ARRAY  B 

SKERrC  =  SUBDIVIDED  KERNEL  ARRAY  B 

I  BOX  =  ARRAY  OF  BOX  CCCES  B 

L3XCD  =  LENGTH  CF  BOX  CCCE  ARRAY  B 

WNG  *  .T..  WING.  .F. ,  TAIL  B 

DIH  =  ,T.,  LEFT  SICE  TO  BE  IGNORED  (SIR FACE  HAS  CIHERL  B 

*  .F„,  LEFT  SIDE  TO  BE  INCLUDED  B 

B 

VALUES  FROM  CGMHCN  -  B 

NSUBCV  =  NUMBER  CF  SUBDIVISIONS  3 

1X8  =  CENTER  CF  FIRST  Ut.SUBDIv[C£D  BOX  RaATlVE  TO  WE  B 

SUBDIVIDED  PATTERN  B 

WXB  -  N*f)CR  OF  OBUSDI VICED  ROWS  B 

HYBB  =  NLWL05  CF  UNSUBDI VIDEO  CHORDS,  INCLUDING  DIAFH.  B 

MY  BBS  =  NUK3ER  CF  SUBDIVIDED  OiCiCS,  INCLUDING  CIAFH.  B 

MX5KRN  =  SIZE  OF  SUBDIVIDED  KERNEL  B 

5YM  =  SYWCTKY  I^CICATCR  B 

B 

L*Or  -  NSUBDV  ♦  N5UBDV/2  ♦  I  B 

E»RUBD  --  SUBDIVIDED  NORKAL-WAuHES  U 

E>F.  US.  EMILS  =  UNSUfiDIVJ  Let1  f  OR  MIL-  WASHES  B 

IPNTDW  -  POINTER  ARRA/  F<jj  UK-UBDI VIDEE  NCR  HAL  WASHES  B 

IPMTSD  =  WINTER  ARRAY  FCR  SOLDI  VICED  NCR  HAL  LASHES  (END-  B 

AROUfC  B 

I PNT3N  =  MTCT  available  i  ointer  b 

IPMTOT  =  FIRST  POWER  IN  USE  B 

IPNTLS  s  DIMENSION  OF  A'sfiAY  !Pf*?SD  B 

LIMDWS  =  DI»O&J0v  CF  SUODI  TIDED  NCR  HAL-WASH  ARRAYS  B 

B 

COMMON  /GEOKTY/  COOAN.NSUBDV,  XSLBJV^CUTDE.^UBCN.NSLRF,  GTCM1Y 

t  Bt  >B1BETA  ,B*S,BtBTAS,W.AX,VLAZ ,  i’SIW,  GCCMTY 

Z  MXBW,MXBr.W,WBW,WDDW,t-:XI?SW.»rrB';W,MYBBSW1  GECMTY 

i  I XBW,  iiCENTR  GECHYY 

LOGICAL  COPUM  CECMTY 

COPCN  /CCCM2  /  TUX,YW?,PSlT.rXBT,NIBT,MrBBT,MYSST,WBST,  CEO *« 

1  MYBSSY,  IXBT ,  IXB^T,CAPL  GEC*£ 

COMMON  /  MODES/  $YM,5YMT,  MTr  PEW,  HTYPET  MOOCCW 

COMMON  /SMASH/  IPNT«D<2,50> ,  ENSUBtU2,600! ,  IPNTIN,  IPNTOf,  IPNTLS  SNWA3M 

IPMTSOIL’WSO) ,  ENSIOC(2*LSLW>  SNW.SH 

COMPLEX  CNSUBD  SKMASH 

COMMON /MWASHES/  lPNTCW(2,tOO)  .DfHAUZVS) ,  EN?lS(1275)  .ICNLAPN  MWASHES 
COMPLEX  SNiUS,  EMiLS  MWASHES 

CCMON  /  AGIN  /  ERR  .MXSKRN,  Ift'.D5N,N*lKRN,NSPATK ,  WOWEA  KERN 

DELPHI  (t MODES)  ,7VP(LTVP)  ,ItX».OC(L’fVr)  DELTmP 

COMMON  /CEL  tap/  CELWI  (I080>  ,  T  VP  (250)  ,  TEXlCC(250>.  FEXLOC  !250) ,  CELT  A  P 


00002 
00003 
00004 
OOOOS 
00006 
00007 
00003 
00009 
00010 
0001 1 
00012 
00013 
00014 
00C15 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024 
0002  5 
00026 
00027 
00026 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
00031’ 
00038 
00039 
00040 
00041 
00042 
00002 
00003 
00004 
0CS05 
00006 
00002 
0C0G3 
00002 
00002 
00003 
00004 
00002 
00003 
00002 
000C2 
00003 
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i  ipntrw<2,ioo)  ,npntr$: 

I  CATLAP 

DELTA  P 

00004 

CCWPLE*  DEL*U ,  TVP 

DELTAP 

00005 

c 

DEFSL  C2  .LNCCES) 

DaTAP 

00006 

DIMENSION  tEFSL<2,1000> 

DELTAP 

00007 

EBOiVALENCE  <DafHI<61),  DEF5U 

DELTAP 

00008 

c 

ARRAYS  BaWI  AND  DEFSL  ARE 

DaTAP 

00009 

c 

EBUi VALENCEB  70  GIVE  A  2  SO*  UN- OVERLAPPED  SECTION 

DaTAP 

00010 

COWON  'LA OT  /  UOT 

B 

00050 

c 

B 

00051 

c 

B 

00052 

COMPLEX  f*FRH.(l>  ,SKEKH.(1S 

B 

00053 

LOU  CAL  WING.OIH 

B 

00054 

c 

B 

00055 

DI*CNSION  13X0X150) 

B 

00056 

LOGICAL  LETT,  LSICE 

B 

00057 

c 

B 

00058 

IA  =  mow 

B 

00059 

B  -  JD.,0.) 

B 

00060 

c 

B 

00061 

IP  (VANG)  GO  TO  20 

B 

00062 

c 

B 

00063 

/X2  =  IXBT 

B 

COO  64 

’KBS  =  IXBST 

b 

00065 

MXR  =  HX8T  -  <IXBT-IX8W)/ASUBCV 

B 

00066 

webs  =  wtbbst 

B 

00067 

ICM.PN  s  ICALAPN 

B 

00066 

SYNTY  =  SYNT 

B 

00069 

CO  TO  2? 

B 

00070 

20  CONTINUE 

B 

00071 

1X3  =  IXBW 

B 

00072 

IXB3  =  1 

» 

00073 

NXJ?  =  HXilBW 

B 

00074 

Ir  (COFLAN)  MXE  =  MXBT 

B 

00075 

WTBB5  i  NTBB5W 

B 

00076 

lOLLF-N  r  0 

B 

00077 

3YHTY  =  SYK 

B 

00070 

23  CONTIS'* a; 

B 

00079 

LSICE  =  SYNTY  .be.  0  .AbC  .NOT.  CIH 

B 

00080 

c 

B 

00081 

c 

IS  SUBDIVISION  REQUESTED  - 

B 

00082 

IF  (MSUBCV  .GS.  t)  GO  TO  410 

E 

000'*  i 

c 

B 

00084 

r 

YES.  CETEKMliC  THE  MJSOER  OF  F-CMJ  WHICH 

CAN  BE  HANDLED  IMXBl) 

B 

00085 

NSfiWC  -  IPNTIN  -  IPMOT  -  i 

B 

0008b 

If  (NSRWn  .LT.  0)  NSRWO  =  NSRWNl  ♦ 

IPNTLS 

B 

00087 

NBRVW1  =  MIK3INSRWH1  .MXSKRN-l) 

B 

00088 

IF  UA  -  IXBS  .CT.  NSR.+tt)  GO  TO  220 

B 

00089 

r 

ALL  SUBDIVIDED.  ALLOW  TO  iO  Of 

BEYOND 

TO  TRIGGER  RETLRN. 

B 

00090 

NXB1  =  IA  -  IXBS  >  I 

B 

00091 

CO  TO  200 

B 

00092 

c 

PARTIAL  SUBDIVIDED 

B 

00093 

120  CONTINUE 

B 

00394 

l  =  IA  -  NSRWfl  -  I  XU 

B 

00095 

I  =  MCCXI.NSLODV) 

B 

00096 

I  i  LRCT  -I 

B 

0009 7 

MXB1  =  NSRMMt  -  MCCO  .NSUBCV) 

9 

30090 

c 

B 

30099 

8150 


DETERMINE  THE  CONTRIBUTION  TO  B  FROM  A  FCRV*RD  CC»C  OF  SUB-  B 
01 VI 13 ED  BOXES  B 

MU  =  RCW  NUACD5  OF  CONTRIBUTING  BOX  RELATIVE  TO  RECEIVING  B 
BOX.  WJ  vF  RECEIVING  BOX  =  0.  B 

IA  =  ACTUAL  ROW  LOCATION  OF  CONTRIBUTING  BOS,  RELATIVE  TO  B 
SUBDIVIDED  GRID.  B 

B 

CONTINUE  B 

IF  (MXB1  .Efl.  0)  GO  TO  310  B 

DO  300  NU  =  l.HXBl  B 

IA  =  IA  -  1  B 

HAS  THE  FORWARD  EDGE  OF  TVIE  PATTERN  BEEN  REACHED  -  B 

IF  UA  .LT.  I*B$)  GO  TO  600  5 

NO.  GET  BOX  TYPE  CODES  '  M  CURRENT  RON.  B 

UEFT  =  .T.  B 

IIA  =  KOOUA-l.IPNTLS)  *1  8 

II API  =  NCCdA.IPNTLSI  ♦  1  B 

IPNTP1  =  IPNTSCd.IIAPl)  B 

IF  (IPNTP1  .LE.  1>  GO  TO  208  B 

NfB  =  IPNTP1  -  I PNTSC (1 , 1  IA)  ♦  IPNT5D(2, 1  IA)  -  1  B 

GO  TO  210  B 

NfB  -  MfBBS  B 

CONTINUE  B 

CALL  DCOCER  UBQX.LBXCt,  IA.l,  IA.NfB,  .T.,  IBxCB  )  B 

IF  (NfB  .  MfBBS)  CO  TO  215  B 

DO  212  I  '  1, MfBBS  B 

IF  (IBXCD(NfB)  .NE.  0)  GO  TO  215  B 

NfB  =  NiB  ••  1  b 

CONTINUE  !5 

CONTINUE  B 

IBXCD  s  RON  OF  BCX  CODES  B 

NfB  =  NJACER  FCUAC  B 

5 

GET  LOCATION  IN  THE  SUBDIVIDED  CONWASH  ARRAY  FOR  BOXUA ,  JCCL)  B 
ISW  s  LOCSCWdA.JCa,  IPNTSCjIPWIN.d^NTOT.tWTLS)  B 

N  =  (N*(N0M)>/2  ♦  1  B 

XCRfCL(NU.MU)  s  SKERK.UNL'MNUMl))/?  *  ACS(MU)  ♦  1)  ,  SO  5 

N  -  SUBSCRIPT  FOR  KERNEL  (STARTING  WITT-!  NU,0  )  B 

B 

CENTER  BOX  OF  ROf  IN  COC  3 

IF  (JCOL  .CT.  NfB)  GO  TO  220  B 

IF  UBXCDOCCL)  .Efl.  0)  GO  TO  220  B 

B  -  B  ♦  SK£RH.(N)  *  (ENSUBDU.IBLO-  ENSUBD(2,ICW)  )  B 

)  CONTINUE  B 


GOING  OUT  fNCM  CENTER  CHORD  OF  COfC  IN  BOTH  DIRECTIONS 


imp  i  dm. 
ibw.idkl 

L 


ID«  *  !DW»! 

I  CM.  *  IDW-l 

ism  *  jcclm 


*  IBXR-2 


=  POINTERS  IN  DOMM-HSH  ARRAY  FCR  RIWT.LEFT  SIDES  B 

*  POINTERS  IN  BOX  CODES  ARRAY,  AS  ABOVE  B 

*  LEFT  SICE  POINTER  INCREMENT ER  (CHANCES  SIGN  VHEN  B 

THE  Pl>HFCKK  CENTER-LPC  IS  ENCOUNTERED)  B 

*  LEFT  SIDE  MULTIPLIER,  USED  TO  DETERMINE  SfMfANT!  B 
8YN.  AFTER  PLAtfCSM  CENTER-LINE  ENCOUNTERED.  B 

B 

B 

B 

B 


00100 
00101 
00102 
00103 
00104 
00105 
00106 
00107 
00108 
00109 
00110 
oom 
cm  12 
coil  3 

00114 

oom 
00116 
00117 
00118 
00119 
00120 
00121 
coi  a? 

00123 
COI  24 
00125 
C0126 
00127 
00128 
00129 
COI  30 
00171 
00132 
00133 
00134 
00), 'it. 
00136 
00137 
00138 
00139 
00140 
00141 
C0142 
00143 
00144 
00145 
00146 
00147 
00148 
00149 
00150 
00151 
COI  52 
00153 
00134 
00155 
00156 


B151 


H  ?  H  ♦  1 

B 

00157 

L  =  -1 

B 

00156 

E  =  1.0 

B 

00159 

c 

B 

00160 

DO  200  MU  =  1,NU 

B 

00161 

c 

B 

00162 

c 

RICHT  SIDE 

B 

00163 

IE  (IDS?  .CT.  WB)  OO  TO  230 

B 

00164 

IE  (IBXCDdB*?)  .EX).  0)  CO  TO  230 

B 

00165 

B  =  B  ♦  SKERM.(N>  *  (ENSUED (1, 1 CWT,  -  ENSUED <2, 1 DVR)  ) 

B 

00166 

230 

CONTINUE 

B 

00167 

c 

B 

00168 

c 

LEFT  SIDE 

B 

001 69 

c 

B 

00170 

IE  (.NOT.  LEFT)  CO  TO  270 

00171 

c 

HAS  PLA’^CRM  CENTER  LINE  BEEN  ENCOUNTERED  - 

B 

00172 

IE  (IB*.  .CT.  0)  CO  TO  250 

B 

00173 

c 

YE5.  SET  PARAMETERS  TO  SWEEP  BACK  ACROSS  RICHT  HALE  AS  A 

B 

00174 

c 

SY.MCTRIC/ANTISYMCTRIC  IMAGE  OF  THE  LEFT  SIDE. 

B 

00175 

LEFT  =  LSI  Cl 

B 

00176 

IF  (.NOT.  LEFT)  CO  TO  270 

B 

00177 

E  -  SYMTY 

B 

00178 

L  =  1 

B 

00173 

IB*.  =  1 

B 

001P0 

I  CM.  =  I  CM.  ♦  1 

B 

00181 

CO  TO  260 

B 

00182 

c 

IE  THE  CENTER  LINE  HAS  PREVIOUSLY  BEEN  ENCOUNTERED,  IB*.  WILL 

B 

00183 

c 

BE  INCREASING.  IE  IB*  HAS  EXCEEDED  THE  NU»®ER  CE  BOXES  ON 

B 

00184 

c 

THIS  ROW,  THIS  ROW  IS  COMPLETE,  TRAfBFER  TO  LOOP  CN  NU. 

B 

\j0185 

zn 

IE  (IB*.  .CT.  WB!  CO  TO  270 

a 

00186 

260 

IE  (IBXCDdB*.)  .EQ.  0)  CO  TO  270 

B 

00187 

B  =  B  ♦  SKERNL(N)  *  (ENSUBDd.IDM.)  -  ENSUBD(2,ICVL)  )  *  E 

B 

00188 

270  CONTI  MJE 

B 

00189 

C 

B 

00190 

C 

SET  COUNTERS  EC?  )CXT  STEP  OUTWARD 

B 

00191 

I  DVR  =  ICVR+1 

B 

00192 

IEM_  =  ICWL*L 

B 

00193 

IB*?  =  IB*?*1 

B 

00194 

IB*.  =  IB**L 

B 

00195 

N  -  N»1 

B 

00196 

200 

CONTINUE 

B 

00197 

C 

ENC  OE  LOOP  ON  MU  (SUBDIVIDED  COLUMNS  OUTBOARD) 

B 

00198 

C 

B 

00199 

300 

CONTIMJE 

B 

00200 

C 

ETC  OF  LOOP  ON  NU  (SUBDIVIDED  ROWS  FORWARD)  FROM  200 

B 

00201 

C 

B 

00202 

C 

IS  THERE  AT  LEAST  ONE  FULL  UNSUBDIVIDED  ROW  LEFT  AHEAD  OF 

B 

00203 

C 

CURRENT  POSITION  - 

B 

00204 

310  CONTI NUC 

B 

00205 

IF  (IA  .LT.  1X8  )  CO  TO  tOO 

B 

00206 

C 

B 

00207 

C 

B 

00208 

C 

UNSUB  DIVIDED  BOXES 

B 

00209 

C 

B 

00210 

c 

DETERMINE  ROW  AND  COLUMN  NUTCERS  IN  SUBDIVIDED  ARRAYS  CORRES¬ 

B 

00211 

c 

PONDING  TO  UNSUBDIVIDED  BOX  CENTERS. 

n 

00212 

c 

IA  =  ROW  LOCATION  OF  CCNTRIBUT.~  SUBDIVIDED  BOX 

3 

00213 

B 1 52 


C  IIA  =  ROW  LOCATION  OF  UNSUBDIVIDED  BOX  B 

C  IN FIRST  ROW  OF  UNSUBDI  VICED  BOXES  TO  USE,  COUNTING  B 

C  OUTWARD.  B 

C  JJJ  =  UNSUBDIVIDED  CHCRD  NLACER  OF  RECEIVING  BOX  B 

C  B 

IA  =  IA  ♦  NSUBC2 
IIA  =  (IA  -  IXBVO/NSUBDV  ♦  1 
INU  =  MX81  /NSUBDV  ♦  1 
JJJ  =  (JCCL-1) /NSUBDV  ♦  1 
CO  TO  420 

SET  UP  POINTERS  IF  NO  SUBDIVISION  WAS  REQUESTED 


C 

c 

c 


410  CONTINUE 

IA  WAS  SET  TO  IRON  UPON  ENTRY 
IIA  =  IA 
INU  =  1 
JJJ=JCCL 


C 

c 

c 

c 

c 

c 


DETERMINE  THE  CONTRIBUTION  TO  B  FROM  A  FORWARD  COE  OF  UNSUB-  B 
DIVIDED  BOXES,  STARTING  WHERE  SUBDIVISION  LEFT  OFF.  B 

MU  =  ROW  NLACER  OF  CONTRIBUTING  BOX  RELATIVE  TO  RECEIVING  B 


BOX.  B 

B 

420  DO  500  NJ  =  INU.MXB  B 

IA  =  IA  -  NSUBDV  B 

IIA  =  IIA  -1  B 

C  HAS  THE  FORWARD  EDGE  CF  THE  PATTERN  BEEN  REACHED  -  B 

IF  <14  .LT.  1X8)  GO  TO  600  B 

C  NO.  GET  BCK  TYPE  COCES  FCR  CURRENT  ROW,  UTCUECI VICED  BOX  B 

C  CENTERS  04. Y  B 

LEFT  =  .T.  B 

IIAVLPN  =  IIA  ♦  ICM.PN  B 

NTS  =  IPNTTWU.UAVLPNM)  -  IPNTDWd  ,  IIAVLPN)  ♦  IPNTCWC2,  IIAVLPN)  B 

1-1  B 

CALL  DCOCER (IBOK,LBXCD,  IIA.l,  IIA.NTB,  .F.,  IBXCD)  B 

C  IBXCD  ~  RCW  OF  BCX  CCCES  B 

C  NTB  =  NUMBER  FOUND  B 

C  B 

C  GET  LOCATION  IN  UNSUBDI VI CEE  DOWWASH  ARRAY  FCR  BCKUIA.JJJ)  B 

IDU  =  LOCSCWd  I AVLPN,  J  J  J ,  IPNTDW,  IUVLPNd  ,1 ,  IIAVLPN»2)  B 


C 

C 


N  «  <NU*<NU+l>>/2  ♦  1 

N  s  UNSUBDIVIDED  KERfCL  SUBSCRIPT  FCR  MU  =  0. 

CENTER  BOK 

IF  (JJ.I  .CT.  NTB)  GO  TO  425 

IF  (IBXCD (JJJ)  .NE.  0)  B  =  9  ♦  f*ERN.<N)*<ORU5<IDW)-DRLS<IDW)  ) 
425  CONTINUE 

GOING  OUT  FROM  CENTER  CHORD  IN  BWH  DIRECTIONS 
IDWt  x  I  DW»1 
I  DM.  x  IOW-1 
IBM)  x  JJJM 
IBXL  *  IBW*2 
L  *  -1 
t  *  1.0 


00214 
00215 
00216 
0021 7 
00218 
00219 
00220 
00221 
00222 
00223 
00224 
00225 
00226 
00227 
00228 
00229 
00230 
00231 
00232 
00233 
00234 
00235 
00236 
00237 
00238 
00239 
00240 
00241 
00242 
00243 
00244 
00245 
00246 
00247 
00248 
00249 
00250 
00251 
00252 
00253 
00254 
00255 
00256 
00257 
00258 
00259 
00260 
00261 
00262 
00263 
00264 
00265 
00266 
00267 
00268 
00269 
00270 
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N  =  H  ♦  1 
C 

DO  480  HU  =  1,NU 

c 

C  RI CUT  Sice 

If  (IB*  .CT.  NTB)  CO  TO  430 

if  <i8xcc<!8W>  .ea.  o>  co  to  430 

B  -  B  ♦  fKERM-(N)  *  (ETRUS(IDVR)  -  ENELSUCWR)  ) 

430  CONTINUE 

c 

c  left  ude 

c 

IF  {.NOT.  LEFT)  CO  TO  470 

C  HAS  HANECRM  CENTER  LINE  BEEN  ENCOUNTERED  - 

IF  UBW.  .CT.  0)  CO  TO  450 

C  YES.  SET  PARAMETERS  TO  SWEEP  BACK  ACROSS  RICHT  SIDE 

LEFT  =  LSI DE 

IF  (.NOT.  LEFT)  CO  TO  470 
E  =  SYHTY 
L  =  1 
IBXL  =  1 
I  CM.  =  I  CM.  ♦  1 

C  TEST  FCR  ROW  COMPLETE,  AS  IN  SUBDIVIDED  LOCIC 

430  IF  (IBXL  .CT.  NT 8)  CO  TO  470 
4C0  IF  (IBXCD(IBXL)  .Efl.  0)  CO  TO  470 

B  =  B  ♦  f*ERN.(N)  *  (ENRUSdCM.)  -  ENRLS(ICVL)  )  *  E 

470  CONTINUE 

C  SET  COUNTERS  FOR  NEXT  STEP  CUTVARD 

ICVR  =  ICVRM 
I  CM.  =  ICM_»L 
IB*  =  IB*+1 
IBn.  =  IBn.N. 

N  =  N  ♦  1 
480  CONTINUE 

C  ETC  CF  LOOP  ON  MU  (CHORDS  OUTWARD) 

C 

500  CONTINUE 

C  END  CF  LOOP  ON  NU  (ROWS  FORWARD)  FROM  420 

C 

c 

BOO  RETURN 
C 

END 


B  00271 
B  00272 
B  00273 
B  00274 
B  00275 
B  00276 
B  00277 
B  00278 
B  00279 
B  00280 
B  00281 
B  00282 
B  00203 
9  00284 
B  00285 
B  00286 
B  00287 
B  0U28C 
B  00289 
B  00290 
B  00291 
B  00292 
B  00293 
B  00294 
B  00295 
B  00296 
B  00297 
B  00298 
B  00299 
B  00300 
B  00301 
B  00302 
B  00303 
B  00304 
B  00305 
B  00306 
B  00307 
B  00308 
B  00309 
B  00310 
B  00311 
B  00312 
B  00313 
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**  N 


c 

c 

c 

c 

c 

c 

c 

r 

C 

c 

c 

c 


c 


SUBROUTINE  CETAICIJUCENT,  ITPE,  ICOCE.  IR) 

GETS  DESIRED  AIC  ARRAYS  FROM  DISK 
JUCENT  =  CHORD  NUHJER 

IT  PE  =  I,  WING/ WINS  3,  RICHT  WING/TAIL 

2.  TAIL/TAIL  4,  LEFT  WING/TAIL 
I CODE  =  0.  C.V.W  DESIRED 
1.  V,W  DESIRED 

2.  W  DESIRED 

IR  =  EFRCR  RETURN  0,  SUCCESS  2,  C,W  NTT  FOM5 

1,  C  NOT  FCUfC  3,  NOTHING  FOUND 

COWON  /FILES  /  NT5.NT6, INTAPE, I)«P,NR_AIC,N5PAIC,NCJUTP, 

1  IOUFSPjMCCESCi I VPSCi I GECEC,  IWTFSC, IAICSC 

COWON  /TAPEICy  TfS,NMS,LS,T*R,ID(20)  ,NID,ITYPC,LRS,LWS,M,N, 

1  PARH(IO)  i  IRR 

OIMOCICN  IPARM(iO) 

EfiUI  VALENCE  IPARM.IPARM) 

COWCN  /MUAICS/  YBAR,EL,MUAIC(2,50)  .TROC.SURF, 
t  YBARLtELLi  MUAICL  <2,  50)  .NROWSL.SURFL,  RSIDIF 

LOGICAL  SURF, SLR FL 

COWQN  /PAICS  /  NOK,  NTTK,  TRWTK,  N.WTK,  PAIC(4,50) 

INTEGER  FAIC 
DIMENSION  NK (4) 

EDUI  VALENCE  OUK,NUl ) ) 

COWCN  /AICS  /  XKVL,  C<1640),W(i640),V(1640) 

COMPLEX  C,  W,  V 

COWON  /ARRAYS/  KBXCDW.LBXCDW.LBOXC.KBXCCT.LflXCDT.KJALFH.LJALPH, 
KALWA,KKERNL,LKeRNL,KPNTRM,LFNTRM,KDEFSL  .KELHHI , 
LMCCES ,  KFNTSD,  LFNTSC ,  KSDW,  LSCW,  KFNTDW,  LFNTCW, 
KDW.LDW.KTVP.LTVP 
LOGICAL  MXWRIT .RANCOU 
DATA  MXVRITtRAfCOU  /  .F.,.F.  / 

DATA  IPAIC.IRAia.IPNT,  IFLAG.IFUGE,  ICCCEP  /  6*0  / 


IR  =  0 

IF  (I TNT  .TC.  0)  G0  TO  ICO 


C 

C  INITIAL  CALL.  SET  UP  FILES  AND  POINTERS 

REWIND  IAICSC 
IPNT  =  1 

C  EXPAT®  PAIC  ARRAY 

I  =  4 

IF  (TRWTK  .EQ.  0)  I  =  3 

IF  <NTTK  .Eft.  0)  I  =  I  -  I 

IF  OU*  ,E3.  0)  I  =  I  -  I 

IF  (H.WTK  .Bi.  Cl)  GO  TO  120 

IF  (I  .Eft.  4)  GO  TO  140 
DO  110  J  s  1.N.WTK 
PAIC  (4,1)  =  PAICII.J) 

PAICII.J)  =  0 
110  CONTINUE 


I  =  l  -  l 
120  CONTINUE 

IF  (TRWTK  .Eft.  0)  GO  TO  130 
IF  <1  .Eft.  3)  CO  TO  140 


GETAIC 

00002 

CETAIC 

00003 

GETAIC 

00004 

GETAIC 

00005 

GETAIC 

00006 

GETAIC 

0000? 

GETAIC 

0C008 

GETAIC 

00003 

GCTmIC 

00010 

GETAIC 

00011 

GETAIC 

00012 

GETAIC 

00013 

GETAIC 

00014 

FILES 

00002 

files 

00003 

TAFEIO 

00Uj2 

TA'TilO 

G0003 

TAPEIO 

00004 

TAPEIO 

00005 

MUAICS 

00002 

MUAICS 

00003 

MUAICS 

00004 

PAICS 

00002 

PAICS 

00003 

PAICS 

00004 

PAICS 

00005 

AICS 

00002 

AICS 

00003 

ARRAYS 

00002 

ARRAYS 

00G03 

ARRAYS 

00004 

ARRAYS 

00005 

GETAIC 

00022 

GETAIC 

00023 

ftnxi 

00061 

GETAK 

00024 

GETAIC 

00025 

GETAIC 

00026 

GETAIC 

00027 

GETAIC 

00028 

GETAIC 

00029 

CETAIC 

00030 

GETAIC 

00031 

GETAIC 

00032 

GETAIC 

00033 

CETAIC 

00034 

CETAIC 

00035 

GETAIC 

00036 

GETAIC 

0003? 

CETAIC 

00038 

CETAIC 

00039 

GETAIC 

00040 

GETAIC 

00041 

GETAIC 

00042 

GETAIC 

00043 

GETAIC 

00044 

GETAIC 

0004  5 
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CO  123  J  1  ,  Mi  VI* 

CCTAtC 

0004* 

•X  1 C  <  S .  > »  J  0*  1 C  <  1  .  J 1 

lctaic 

0004 1 

«X(C(I.J1  *  0 

CCTAIC 

0004 

125  CCNTJMUE 

CCTAIC 

00049 

1*1-1 

CCTAIC 

00050 

130  CONTINUE 

CCTAtC 

00031 

1  F  INI TX  .CO.  0)  OO  TO  140 

CCTAIC 

00052 

IF  (|  .CB.  21  OO  TO  140 

CCTAIC 

00033 

DO  135  J  =  1  .NTTK 

CCTml 

0 03 S4 

r«;c(2.ji  =  ►•Aicu.J) 

CCTAIC 

00035 

P»IC<1  ,J>  =  0 

CCTAIC 

0003* 

135  CCNTINLC 

CCTAIC 

0005  r 

t40  cottiujc 

CCTAIC 

00034 

c 

zero  an  the  aic  array!. 

CCTAIC 

00059 

DO  150  l  s  1  .LKERN. 

CCTAIC 

000*0 

cm  =  (O..0.1 

CCTAIC 

OOOtl 

w<n  =  (O..0.1 

CCTAIC 

000« 

V(I)  :  (D.,0.1 

CCTAIC 

000*3 

150  continue 

CCTAIC 

000*4 

c 

CCTAIC 

000*3 

c 

OCT  THE  AIC  LOCATION 

CCTAIC 

00005 

103  CONTINUE 

CCTAIC 

000 *T 

IF  (NKITPE)  .LT.  JUCENT1  CO  TO  290 

CCTAIC 

000*4 

ILOC  -  PAICOTPE,  JUCENT) 

CCTAIC 

000*9 

c 

ARC  THE  C  ESI  REE  ARRAYS  ALREACY  IN  CORE  - 

CCTAIC 

000 TO 

IF  (ILOC  .CB.  IPAIC)  OO  TO  300 

CCTAIC 

OOOTl 

IPAIC  =  ILOC 

CCTAIC 

000 T2 

ILOC  =  (ILOC-t  1  *4  ♦  1 

CCTAIC 

000 TJ 

c 

CCTAIC 

000 T4 

c 

CET  THE  HUAI C  ARRAY  FROM 

THE  N0N-R_ANAR 

AIC  SCRATCH  FILE 

CCTAIC 

000 T  3 

c 

CCTAIC 

000 T6 

c 

SPACE  A>C  READ  HUAICS 

CCTAIC 

ooo  rr 

CALL  RCINIT 

CCTAIC 

000T8 

IF  (ILOC  -  IPNT)  200,220,210 

CCTAIC 

000 T9 

c 

HUAICS  ARE  BEHITC  CURRENT 

LOCATION 

CCTAIC 

oooeo 

200  REWIND  I A [CSC 

CCTAIC 

00061 

NO  =  ILOC  -1 

CCTAIC 

00082 

CO  TO  220 

CCTAIC 

00043 

c 

CCTAIC 

00044 

c 

NCBUlREE  HUAICS  ARE  AHEAD 

OF  CURRENT  POSITION 

CCTAIC 

00085 

210  CONTINUE 

CCTAIC 

00046 

NO  s  ILOC  ••  IPNT 

CCTAIC 

oooer 

c 

CCTAIC 

00048 

c 

REAO  HUAICS  FROM  JAICSC 

CCTAIC 

00069 

220  CONTINUE 

CCTAIC 

00090 

KXAftftY  *  CM  HUAIC 

CCTAIC 

00091 

K  »  2 

CCTAIC 

00092 

CALL  REACH*!  IAICSC,  MXW? I T , AA1COU,  1E|,IM, 

LS.Wt,  K,  MID,  ID, 

CCTAIC 

00093 

1  I TYPE,  LRS,  HUAIC,  M,N,  FARM, 

IRR) 

CCTAIC 

00094 

IF  (IRA  .*€.  01  CO  TO  3000 

CCTAtC 

00093 

MKMI  ■  H 

CCTAIC 

0009* 

IPNT  ■  ILOC  ♦  1 

CCTAtC 

0009 T 

a  ■  PAAMdl 

CCTAIC 

00096 

YBM  ■  FARM  (41 

CCTAIC 

000*9 

ICO  ■  IFARM(S) 

CCTAIC 

00100 

c 

CCTAIC 

00101 

CALL  RCINIT 

CCTAIC 

00102 

8156 


C  IS  THE  C  ARRAY  DESIRED  - 

IF  (ICOCE  .>C.  0)  GO  TO  250 
C  YES.  IS  IT  AVAILABLE  - 

IF  (ICC  .Efl.  0)  OO  TO  240 
C  NO.  SET  THE  ERROR  FLAO  AND  CONTI  NJE 

IR  =  1 
OO  TO  250 

C  READ  THE  C  ARRAY  FRCM  IAICSC 

240  CCNT I NUE 

MXARRY  =  9HSFATIAL  C 

CALL  REACMXI  IAICSC,  MXVRIT.RANCOU,  lES.NMS,  L5.1MR,  K,  NIC,  ID, 

1  I  TYPE,  LRS,  C,  M,N,  FARM,  IRR) 

IF  (IRR  .T£.  0)  OO  TO  5000 
CALL  RBIWT 
CO  TO  260 
250  CCNTIME 
WtS  =  1 
260  CONTINUE 

IPNT  =  IPNT  4-  1 

C  READ  THE  W  ARRAY  PR  CM  IAICSC 

MXARRY  ~  9HSRATIAL  W 

CALL  READMXt  IAICSC.  M'MUT.RANDCU,  NFS,f+6,  LS,t*R,  K,  NIC,  ID, 

1  I  TYPE,  LRS,  W,  H.N,  FARM,  IRR) 

IF  (IRR  .fC.  0)  OO  TO  3000 
IPNT  =  IPNT  ♦  1 
CALL  RCINIT 

C  IS  THE  V  ARRAY  DESIRED  - 

IF  (ICOCE  .EB.  2)  GO  TO  300 
C  YES.  IS  IT  AVAILABLE  - 

IF  (ICO  .ft.  2)  GOTO  280 
C  NO.  SET  ERROR  FLAO 

IN  s  IR  ♦  1 
CO  TO  300 

C  READ  THE  V  ARRAY  FRCM  IAICSC 

280  CONTINUE 

MXARRY  =  9HSFATIAL  V 

CALL  READMXI  IAICSC,  MXWUT.RAUXU,  f^S.MMEi,  LS,t*R.  K>  NIC,  ID, 

1  I  TYPE,  LRS,  V,  M,N,  FARM,  IRR) 

IF  (IRR  .fC.  0)  CO  TO  3000 
IPNT  =  IPNT  <v  1 
CO  TO  300 
C 

C  MO  AICS  CAN  BE  FOUtC  CF  THE  TYPE  DESIRED  FCR  THIS  CHORD 

290  IR  =  3 
C 

300  CONTINUE 
RETURN 
C 

C  JJACM08TIC 

C 

3000  CONTINUE 

MUTE  (NTS, 9000)  IAICSC, IRR 
MUTE  (NT®, 9192)  MXARRY,  N,N 
CALL  FLUSH  (1  > 

9000  FORMAT (49H***  ERROR  -  VHILE  READING  FRCM  SPATIAL  AIC  FILE  ,AtO, 

1  I4K,  ERROR  CCCE  =  14,  4H  ***  ) 

9192  FCR  MAT  (14X,  A10,  20HAFRAY,  Ci  KNSU’^CD  (14 ,1H,  14 ,1 1H>  MAS  BEING 


CETAIC  00103 
CETAIC  00104 
CETAIC  00105 
CETAIC  00<06 
OETAIC  0010? 
CETAIC  00108 
CETAIC  0G109 
CETAIC  00110 
OETAIC  00111 
OETAIC  00112 
OETAIC  00113 
OETAIC  00114 
OETAIC  00115 
CETAIC  00116 
OETAIC  0011? 
CETAIC  00118 
CETAIC  00119 
CETAIC  00120 
OETAIC  00121 
OETAIC  00122 
OETAIC  00123 
OETAIC  a)l  24 
GETAIC  00125 
OETAIC  00126 
OETAIC  00127 
OETAIC  00128 
OETAIC  00129 
OETAIC  00130 
GETAIC  00131 
CETAIC  00132 
CETAIC  00133 
CETAIC  00134 
CETAIC  00135 
CETAIC  00136 
GETAIC  00137 
GETAIC  00138 
GETAIC  00139 
GETAIC  00140 
CETAIC  00141 
OETAIC  00142 
GETAIC  00143 
CETAIC  00144 
GETAIC  00145 
OETAIC  00146 
GETAIC  00147 
OETAIC  00148 
GETAIC  00149 
CETAIC  00)50 
CETAIC  00151 
GETAIC  00152 
GETAIC  00153 
OETAIC  00154 
CETAIC  00155 
CETAIC  00156 
CETAIC  0013? 
OETAIC  00158 
OETAIC  00159 


3157 


1  IK  READ  ) 

ENC 


CCTAIC  00160 
CETAIC  00161 
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SUBROUTINE  STOBCWdRCW, JCCL ,  EN,  IBOX.LBXCD,  IXB.MXBS.WB,  IRR) 

STORES  A  COMPUTES  OOWMWASH  VALUE  IN  THE  EtC- AROUND  SUBDIVIDED 
DOWNWXSH  ARRAY,  ANC  UPDATES  POINTERS  WHEN  NECESSARY 


IRON 

jca 

EN 
I  BOA 

LBXCD 

IXB 

MXBC- 

MYB 

RETURN6  - 
IRR 


=  BOA  CHCRCWISE  LOCATION 
=  BOA  S PANWISE  LOCATION 
=  COMPLEX  NCRMAL-WASHES  TO  BY  STORED 
=  ARRAY  C F  BOA  CODE? 

=  LENGTH  CF  BOA  CODE  ARRAY 

-  FIRST  SUBDIVIDED  ROW  OF  THE  FLA NF CRM 

=  MAXIMUM  CHORD  LENGTH  OF  SUBDIVIDED  PATTERN 

-  MAXI  MM  ROW  LENGTH 


IRR  =  ERROR  RETURN,  0  =  SUCCESSFUL 

=  1,  FUNCTION  LOCSCW  FOUND  TH'  POINTER  OUTSIDE 
THE  DEFINED  SET  OF  DOWNWkSHES 
ENSUED  =  SUBDIVIDED  NCR  HAL- WASH  ARRAY  WITH  ADDED  VALUE 

COMCN  PARAMETERS  USED 

MXSKRN  =  MAXIMUM  SIZE  OF  THE  SUBDIVIDED  KERNEL 
I.SDW  =  DIMENSION  OF  SUBDIVIDED  NORMAL  WASH  'RRAY 
IPNTSD  =  POINTER  ARRAY  FOR  SUBDIVIDED  NORMAL  WASH  ARRAY 
IPNTIN  =  NEXT  AVAILABLE  CELL  IN  IPNTSD 
IPNTOT  =  FIRST  CURRENTLY  VALID  CELL  IN  IPNTSD 
IPNTLS  =  DIMENSION  OF  IPWTSD 

COMO*  /  KERN  /  ERR.MXSKRN.IFXERN.NTLKRN.NSFATK.WOWEA 
C04HCN  /ARRAYS/  KBXCDW,  LB  XCCW,  LBOXC » KBXCCT ,  L3XCCT .  K  J  ALHH ,  L JALHH , 

1  KALHtt,KKERM.,LKERM.,KPNTRM,LWTRM,KDEFSL,KELfHI , 

2  LMOCES,KPNTSD,LPNTSD,KSCW,  LSCW,KPN1DW,LPNTBW, 

3  KOW.LCW.KTVP.LTVP 

COM40N  /SNUKSH/  I  PNTSD  <2 , 50  > ,  EN6UBD<2,600) ,  I PNTIN,  I FNTOT,  IPNT1  S 
I PNTSD  (LPNTSD) ,  ENSUBD  (24LSEW) 

COMPLEX  ENSUED 

COMCN  /CHECK PR/  CPPCFR ,  GEOCFR , HCCCFR ,  AI Cu r,~ ,  NAJSCFR ,  SMCFR ,  GAf'CPR 
LOGICAL  DPFCPR,  GECCFR,  MCCCRR.  AICCFR ,  MASCFR,  SMCFR,  GAFCPR 
BUI  VALENCE  (CHECK  FR ,  NW3CPR) 

LOGICAL  CHECKER 
DIECNSICN  TITLC3) 


COMPLEX  ENC2) 

IRR  :  0 

IS  THIS  THE  INITIAL  CALL  - 
IF  XIRCW  .Efi.  IXB  .AW.  JCa  .Eft.  1)  GO  TO  TOO 
MO.  IS  A  NCW  ROW  BEING  CONSIDERED  - 
IF  MRCW  ,GT.  I CROW)  GO  TO  200 

MO.  GET  THE  LOCATION  FCR  THE  VALUE  IN  THE  SUBDIVIDED  DCWN- 
WASH  ARRAY 

IJ  *  LOCSDWUROW.JCCL,  I  PNTSD,  I  PNTIN,  IPNTOT,  IPNTLS) 

IF  UJ>  900,900,550 

MUST  UPDATE  POINTERS  AND  ADD  A  ROW  TO  THE  SUODI VIDEO  BOX  ARRAY 
ZOO  fONTINUC 

JOACW  i  IRCW 


STOSCW 

STC8DW 

ST06DW 

STOSDW 

STOSCW 

STOSDW 

ST06DW 

STOSCW 

STOBDW 

ST06CW 

STOBDW 

ST06CW 

STOBDW 

ST06DW 

STOBDW 

STC6CW 

STOBDW 

STC6CW 

STOBDW 

STOBDW 

STCGDW 

STOBDW 

STOBDW 

STOSCW 

STC6DW 

STCCCW 

STOBDW 

KERN 

ARRAYS 

ARRAYS 

ARRAYS 

ARRAYS 

SNWFSH 

SNt«*SH 

SNMKSH 

CHECK  FR 

CHECKER 

ST06DW 

STOFDW 

STOBDW 

STCSCW 

STOBDW 

STOBDW 

STOBDW 

STOBDW 

STOBDW 

STC6DW 

STOBDW 

STOBDW 

STOBDW 

3TC8DW 

STC8DW 

STOBDW 

ST06CW 

3TC6DW 

STcerw 

stocrw 


00002 

00003 

00004 

00005 

00006 

00007 

00008 

00009 

00010 

00011 

0CO12 

00013 

00014 

00015 

00016 

00017 

00018 

00019 

00020 

00021 

00022 

00023 

00024 

00025 

00026 

00027 

00028 

00002 

00002 

00003 

00004 

00005 

00002 

00003 

000C4 

00002 

00003 

00033 

00034 

00035 

00036 

00037 

00038 

00039 

00040 

00041 

00042 

00043 

00044 

0004S 

00046 

00047 

00C48 

00049 

00050 

DOOM 

00052 


c 

SET  THE  NEXT  VALUES  C f  THE  POINTER  ARRAY  tl  ROW) 

ST06DW 

00053 

c 

INCREMENT  IPNTIN,  ALLOWING  FOR  EKO-AROJNE  INCREMENTAL 

STC6DW 

00054 

!**<T  =  IPNTIN 

STC6DW 

00055 

It  =  JFNT$D<t,  IPNTIN) 

STCSDW 

00055 

CALL  POINTR  (tRCW,  l.MYB.  .T...T.,  IBOX.LBXCD,  IPNTLS. 

STCSDW 

00057 

1 

it.  ipntin.ipntsd; 

STCSDW 

00058 

c 

STOBDW 

00059 

c 

LOOP  INCREMENTING  IPNTOT,  IF  OVER -LAP  OCCURS. 

STOSDW 

00060 

220  COMTINUE 

ST06DW 

00051 

IF  (IPNTIN- IPNTOT)  230,225.235 

STOSDW 

00062 

225 

IPNTOT  =  MCCdPNTOf  .1PNTLS)  +1 

STCSDW 

00063 

GO  TO  220 

STCSDW 

00054 

230 

ISKOWS  =  I PNT I N- 1 FNT  Ol  ♦  I PNTLS 

STCSDW 

00065 

GO  TO  240 

STCSDW 

00066 

235 

l  SR  CVS  =  IPNTIN-IPNTGT 

ST06DW 

00067 

240 

CONTINUE 

STCSDW 

0006$ 

IF  <  I  SR  CMS  .Gf.  MXSKRN)  IPNTOT  -  MCCdPNTOr+ISROWS-MXSKRN-l , 

STCSDW 

00069 

1 

I PNTLS)  ♦  1 

STCSDW 

00070 

c 

STCSDW 

00071 

c 

KEEP  SUBDIVIDED  DCVNWASHES  END- AROUND. 

STCSDW 

00072 

c 

NAS  THE  ARRAY  LIMIT  BEEN  EXCEEDED  - 

STCSDW 

000 73 

IO.D  =  IPMTSDd  ■  I NM1 ) 

STCSDW 

00074 

IF  (IPNTSDd.  IPNTIN)  .LE.  LSDW  ♦  1)  GO  TO  405 

STCSDW 

00075 

c 

LIMIT  EXCEEDED  BY  CURRENT  ROW.  PUCE  AT  BEGINNING  CF  IHE  ARRAY 

STCSDW 

00076 

IF  (.NOT.  CHECK  PR)  GO  TO  400 

STCSDW 

00077 

TITUl )  -  10HEM  SUBDIVI 

STCSDW 

00078 

riTL(2)  2  lCHCED.  UP<=ER 

STCSDW 

0007$ 

TITLC3!  2  10H,  PARTIAL 

STCSDW 

00080 

IF  (IPNTIN  .LT.  IPNTOT)  GO  TO  395 

STCSDW 

00081 

CAIL  RRINTR(TirL.O.  ENSUED. 2.  IPNTOT,  IFNTIN-1  ,KYB.  IPNTSD) 

STCSDW 

00082 

GO  TO  400 

STCSDW 

00083 

395 

CALL  FRINTR  (TI  TL .0 , OSLBD.2,  IPNTOT .  I PNTLS- 1 ,  WB.IPNTSD) 

STCSDW 

00084 

CALL  PRI MTR  (TI TL .0 .  ENSLBD.2 .  1,  IPN7IN-1,  WB.IPNTSD) 

STCSDW 

00085 

400 

CONTINUE 

STCSDW 

00086 

IPNTSDd,  I  PNT  IN)  =  IPNTSDd,  IPNTIN)  -  KXD  ♦  l 

STCSDW 

00087 

IPNTSDd,  11*0)  =  1 

STC6CW 

00038 

c 

STCSDW 

00089 

405 

CONTINUE 

STCSDW 

00080 

I PM  r  IPNTSDd  ,I?!M1> 

STCSDW 

00091 

IPI  =  IPriTSDd, IPNTIN) 

STCSDW 

00092 

IPO  2  IPNTSDd  .IPNTOT) 

STOSDW 

00093 

c 

STCSDW 

00094 

IF  (IO.D  . Gl ,  IPO)  GO  TO  430 

STCSDW 

00095 

c 

STCSDW 

00096 

c 

ARRAY  WAS  ALREADY  EJO-AROUTC  FRICR  TO  UTEST  ADDITION 

STCSDW 

00097 

IF  (ICLO  .ea.  I  PM)  GO  TO  440 

STCSDW 

00098 

c 

ACCCP  ROW  WENT  END- AROUND  AS  WELL 

STCSDW 

00099 

410 

IPNTOT  2  MCC (IPNTOT,  I PNTLS)  ♦  1 

STCSDW 

00100 

IF  (IPNTSDd,  IPNTOT)  .*£.  1  >  GO  TO  410 

STCSDW 

00101 

JPNTOT  =  MOC (IPNTOT,  I OHTLS)  ♦  1 

STOSDW 

00102 

IPO  2  IPNTSDd, IPNTOT) 

STCSDW 

00103 

GO  TO  440 

STCSDW 

00104 

c 

STCSDW 

C0105 

c 

ARRAY  WAS  SEflUENTIAL.  CHECK  WItTHER  IT  HAS  CO C  END- AROUND 

STCSDW 

00106 

430 

CONTINUE 

STCSDW 

00107 

«r  (iac  .Ea .  ipm)  go  to  500 

STCSDW 

CO  108 

c 

IT  HAS  GONE  ENC-ARCUNC 

STCSDW 

0010) 

B 160 


Msmsmuams  wam*&n&£*mm* 


c 


4*0  CONTI  HUE 

C  HAS  THE  AP.RAY  BEEN  CNER-W»TTEN  IN  GOING  EhC-ARCUIC 

IF  (IPO  .CT.  IPI1  CO  TO  500 
C  YES.  MCWE  IPNTOf  UNTIL  CLEAR. 

IPNTOT  -  MCCdPNTOT.IPNTLS)  ♦  l 
IPO  =  I PNTSDU,  IPNTOT) 

IF  (IPO  U  CO  TO  440 

C 

C  ALL  POINTERS  HAVE  BEEN  RE3CT .  CCT  LOCATION 

300  CONTINUE 

IJ  =  LOCSDU<IRON,.ICOL,  I FNTSD,  I FNTIN,  I PNTOT ,  IPNTLSI 
IF  UJ  .Efl.  0)  CO  TO  900 
C 

C  STORE  THE  DOWKWISH  VALUE 

590  CONTINUE 

EWvJEDa.IJ)  =  EN(l) 

D6ieD(?,IJ)  =  EN(2) 

600  RERUN 
C 

INITIAL  CALL 
700  CONTINUE 

IPNTOT  =  MCCdXS-l.IPNTLS)  ♦  1 
I  PUTIN  =  IFNTOT 

NX  =  MIKKMX8S-IXB+1,  MXSXRNi  IPNTLS-l) 

C  SET  UP  POINTER  ARRAY  FOR  FIRST  FASS 

CALL  POCNTCdXB,  MX.MYB,  .T.,  .T.,  IBOX.LBXCD,  IPNTLS, 

1  t.  IPNTIN,  IPNTSD) 

720  CONTINUE 

IF  (IPNTSCd.lfTTTIN)  .LE.  LSCW  )  GO  TO  730 
IPNTIN  =  IPNTIN  -  1 
MX  =  NX  -  1 
CO  TO  7£0 
730  CONTINUE 

I  CROW  =  MX  ♦  1 1®  -  1 

c 

ENSUBCd.l)  =  ENU) 

EHSUBD(2,1)  =  EN<2) 

CO  TO  600 

«  ' 

C 

C  ERROR 

900  IRR  =  i 
GO  TO  600 
C 

DC 


STQSCW  oono 
ST06CW  001 n 
STCSDW  00112 
STQSCW  00113 
STQ6DW  00114 
STQSCW  00115 
STQSCW  00116 
STQSCW  00117 
STC6CW  00118 
STQSCW  00110 
STQSCW  00120 
STOBCW  00121 
STQ6CW  00122 
STC6DW  00123 
ST06CW  00124 
STCSDW  00125 
STC6CW  00126 
STQSCW  00127 
STC6CW  00128 
STC6CW  00129 
STQSCW  00130 
STQSCW  00131 
ST06CW  00132 
STQSCW  00133 
STQSCW  C01 34 
STQSCW  00135 
STC6CW  00136 
STQSCW  00137 
SY06DW  00138 
STCSDW  00139 
STCSDW  00140 
STCSDW  00141 
STCSDW  00142 
STQSCW  00143 
STCSDW  00144 
STCSDW  00145 
STQSCW  00146 
STCSDW  00147 
STOBCW  00148 
STQSCW  00149 
STCSDW  00150 
STOSCW  00151 
STCSDW  00152 
STCSDW  00153 
STCSDW  00154 
STCSDW  00155 
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SUW0UTI1C  PRINTFH  TITL,  IHCCE, ARRAY  ,K, !  *B ,  MXB ,  MYB ,  I PNTRM) 

FRNTNW 

00002 

c 

FRNTNW 

00003 

r 

TITS.  -  TITLE  TO  PRINT  FCR  THE  ARRAY 

FRNTNW 

00004 

c 

IHCCE  -  HCCE  SHAPE  NUMBER 

FRNTNW 

00005 

c 

ARRAY  -  ARRAY  TO  RE  PRINTED 

FRNTNW 

00006 

c 

FRNTNW 

00007 

DI »€<* ION  ARRAY  (K,l) ,  TITL(3> 

FRNTNW 

00008 

CCMFEE'X  ARRAY 

FRNTNW 

00009 

DIHEWION  IPNTRM(2,50) 

FRNTNW 

00010 

CCMMON  /CCNTRL/  PREVEX, CMACH,  TITLE(8).  FRVGECM,  FRVMCCE,  BIHW,  BIHT, 

CCNTRL 

00002 

I  DEFAULT 

CCNTRL 

00003 

LOGICAL  PRVGECM,  fRVHCCE, DIHW,  DIHT ,  DEFAULT 

CONTRL 

00004 

CO*«N  /FRCfiLH/  XTttOT.FWCCES.NTSLOP.MCVALS, SMOOTH, NDEG,CRDcIT, 

FRCSLM 

00002 

1  EXAIC.SUBDV.PEYWCXC 

FRCfiLH 

00003 

LOGICAL  SMOOTH,  CRCFTT.EXAIC.SUBDV.PLYWOCC 

FRCfiLH 

00004 

COH4CN  /FILES  /  NTS,  NT6,  INTAPE,  UfS’.'-.NPLAIC.NSPAIC.NCUTP, 

FILES 

00002 

l  I0UFSP,MCCESC,IVPSC,IGe08C,IWrnsC,IAICSC 

FILES 

00003 

0*04  /XVAL  /  IKVAL,WVAL(20),  WS<?0) 

KVAL 

00002 

CIMEjeiCN  PC  (2) 

FRNTNW 

00016 

DIMENSION  S  (50)  ,  C  (50) 

FRNTMW 

00020 

EQUIVALENCE  (SCI),  BUFF  <1 ) )  ,  (CC1)  ,  BUFF  (1251) ) 

FRNTMW 

00021 

REAL  K1 

FRNTNW 

00022 

INTEGER  PAGE 

FRNTNW 

00023 

CO**CN  /RVCUFF/  EFCCCE.IBFCNT,  BUFF (3280) 

RVCUFF 

00002 

DATA  PC  /  1  OH  PAGE  CONTI ,  AH  SUED  / 

FTNX1 

00063 

DATA  BLANC  /  1H  / 

ftnxi 

00064 

DATA  XIWT  /  -1.0  / 

ftnxi 

00065 

!C1  --  XKVAL(IKVAL) 

FRNTMW 

00024 

IF(XK3(IKVAL)  .►C.XINir)  K1  =  UCS(IKVAL) 

FRMTNW 

00025 

c 

FRNTMW 

00026 

c 

FRNTHV 

00027 

PAGE  =  0 

FRNTMW 

00028 

N  =1 

FRNTNW 

00029 

M  =4 

FRNTNW 

00030 

IF(N.GT.HTB)  H  =  WB 

FRNTNW 

00031 

100 

LINE  -  100 

FRNTNW 

00032 

200 

DO  1  AOO  l  =  IXB.MXB 

FRNTNW 

00033 

DO  300  J=N,M 

FRNTMW 

00034 

5(J)  =  0.0 

FRNTNW 

00035 

0(J)  -  0.0 

FRNTNW 

00036 

300 

CONTINUE 

PR  NT  MV 

OCO’7 

IF (LINI.LE.50)  GO  TO  900 

FRNTMW 

000 .,8 

PACE  -  PACE  ♦  t 

FRNTNW 

00039 

lin:  -  a 

FRNTMW 

00040 

VRiTE  (NT6.9001)  TITLE, TITL,  XMACH,  K1 ,  IHCCE 

FRNIJW 

00041 

c 

PR  NT  MV 

C0042 

If  (P»GT.Ea.I)  CO  TO  TOO 

FRNTNW 

00043 

WUTE  (NT6.9005)  PC 

FRNTNW 

00044 

GO  TO  cor, 

FRNTNW 

00045 

100 

VR(TE<NTC,9005) 

FRNTNW 

00046 

aoo 

CONTINUE 

FRNTNW 

0004  7 

VRM£(NT6,6006>  (BLAMC,J,J=N,H) 

PRNTNW 

00048 

w?)  n:(NT6,6oai)  (blanc,  j=n,h) 

FRNTNW 

00049 

900 

CONTINUE 

FRNTNW 

00050 

ji,  -  1  PNTRH12, 1 ) 

FRNTNW 

00051 

If  ( j S  LE.  0)  GO  TO  1400 

FRNTIAV 

000',  2 

IE*  :  IP*NRH<1  ,1) 

PRNTNW 

000',  5 

JE  MPNTRM<1,!*1)  -  ICX  ♦  J5  -1 

PR  NT  MU 

00054 

IF(JE.EQ.Q)  CO  TO  1400 

PRNTNU 

00055 

CO  1000  J=JS,JE 

PR  NT  MU 

00056 

StJV  t  REAL  JARfiAY  U.  I  OX!  } 

PRNTMU 

00057 

0<J)  =  AIMAC(ARRAY  {1 ,  ICX)  ) 

PRNTNU 

00C56 

IOX  :  IDX  41 

PRNTNU 

00059 

1000  CONTINUE 

PRNTNU 

00060 

DO  1200  J=N,H 

PRNTMU 

00061 

IF(SU))  1300, 1100, 1300 

PR  NT  MU 

00062 

1100  CONTINUE 

a?  NT  MU 

QUO  63 

IF<0(J))  1300,1200,1300 

PRNTNU 

00064 

1200  CONTINUE 

PRNTMU 

00063 

GO  TO  1400 

PRNTMU 

00066 

1300  VRITE  (NT6.9013)  ! ,  <SU5  ,DU) ,  J=N,M) 

PRNTNU 

00067 

U«  =  UPC  ♦  1 

PRNTNU 

00066 

1400  CONTINUE 

PRNTNU 

00069 

M  =  M*4 

PRNTMU 

00070 

N  =  Nc-4 

PRNTNU 

0007) 

IFtN.CT.WB  )  CO  TO  1500 

7RNTNU 

00072 

IF(M.OT.MYB  )  K=MYB 

PRNTNU 

GOO  73 

lFtLIPC.0T.45)  CO  TO  100 

PRNTMU 

00074 

VRITE(N16,6G06)  (BLANC ,  J ,  J“N,  M) 

PRNTMU 

00075 

W«ITE<»v76,€007>  (BLANC,  J=N,M> 

PRNTNU 

00076 

LINE  =  LIKE*  3 

PRNTNU 

00077 

GO  TO  200 

PRNTNU 

000 A, 

1500  CONTINUE 

PRNTNU 

00079 

RETURN 

prntm; 

00080 

9001  FORMAT <1H1,20X,8A10/  50X.3A10/  46X,  '/HI  MACH  F5.3.5X.10PCED. 

FREQ.  PRNTNU 

0C08I 

1  *=*,FB.5,  *  J*  /52X,*MC0E  SHAPE*  ,13) 

PRNTNU 

0008? 

9005  FORMAT (44X,42(1H-)  ,cOX,A10,A4) 

PRNTNU 

00083 

0306  FCRMAT (4HOROU,  A1 ,14X,  5HCHO;C,  13,  3  (A1 ,22X,  5HCHCRC,  13)  ) 

PRNTSUU 

00084 

0307  FORMAT (3X,  4 {A1 ,9X, <KREAL,BX, 9HI MACINARY)  > 

PRNTNU 

00085 

9013  FORMAT <14, 8E1S.8) 

PRNTNU 

00066 

EMC 

PRNTNU 

00087 

B163 


scrotum  ccccerubox.lbcx,  ia.ja,  Il.jl,  subd,  iccce> 

CIHEN6ICN  IBOXtLBOX.l )  ,  ICCCEd) 

I  BOX  -  ARRAY  CP  80X  COCE5  IN  PACKED  UCRD  FCRhAT 

LBOX  -  ROW  DIMENSION  CP  30K  CODES  ARRAY 

IA  -  I-TH  INDEX  CP  FIRST  CCCE  TO  RETRIEVE 

JA  -  J-TH  I NDEX  OF  FIRST  CCCE  TO  RETRIEVE 

IL  -  UST  DC*  CCCE  ON  THE  Ja-TVI  CHORD  TO  RETRIEVE 

JL  -  UST  BOX  CM  THE  1A-TH  ROW  TO  RETRIEVE 

Sl*D  -  ,T.,  SU5BIVIDED  BOX  CODES  DESIRED,  .F.  UNSUBDI VICED. 

ICCCE  -  ARRAY  INTO  VHICH  BOX  COCE  WILL  BE  STORED, 

CO*€NT  CN  USAGE 

BOX  COXES  CAN  BE  RETRIEVED  FCR  <»C  BOX,  ,\  RCW  CR  FART  OF 
A  RCW,  OR  A  COLUMN  CR  PART  CP  A  CCLUMN.  A  RO(  AND  COLUMN  CAN 
NOT  BE  RETRIEVED  AT  THE  SAME  TIME.  IF  CN.Y  1  BOX  IS  DESIRED 
SET  IL  =  IA  Aft  JL  =  JA.  IF  BOTH  IL  .f€.  IA  AND  JL  .NE. 
JA,  ONE  RCW  WILL  BE  RETURNED,  IL  BEING  IGNORED. 

CCMCW  /GECK1Y/  C0n_AN,f6USDV,XSU£DV,NSUBD2,NSUBCN,NSlRF. 

1  Bt  ,B1  BETA , BIS, B1 BTAS ,VCAX,W_AZ ,  PSIW, 

2  MXBW,  MXBBW,  HY  BW,  MY  BBW,  MXBSW,  MY  BSW,  MYBBSW, 

3  IXBW.XCEKIR 
LOGICAL  COPUN 

LOGICAL  SUBD 
INTEGER  SHIFT 
DATA  ICVRC  /2Q/ 

MASK  =  7 
IB  =  1 

IF  <SUBD>  GO  TO  50 
I  =  MUBCV  *  OA-I)  ♦  IX3W 
J  =  NSUBCV  ♦  (JA-1)  ♦  NSUECN 
ISMP  =  NSUBCV 

IEFC  r  NSUBCV  *  UL-I)  >  I XBW 
JE>C  :  NSUBCV  *  (JL-11  ♦  NSUTK -J 
CO  TO  60 
30  CONTINUE 
I  =  IA 
J  =  JA 
I3KIP  =  1 
I END  =  IL 
JEM!  =  JL 
80  CONI  I  HUE 

IF  (JL  .EC.  JA)  CC  TO  1100 

PROGRAM  WILL  RETRIEVE  N1  BOXES  FROM  ROW  I 
100  CONTINUE 

DO  1000  JJ  =  J.JEM.ISXIP 
JSB  =(JJ-t)/)€W<D  *  I 
JjVCRD  =  IBOXU.JSB* 

jb  =  oewio  -  moc(jj,mw;o>  )  *  3 
IFOB.Ea.60)  JB  =  0 

Ji  -  M>€ER  CP  BITS  TO  SHIFT  LEFT. 

UHASKi  8H?rT(HASX,JB) 

IJCOCE  =  I  JWTRD,  AND .  I J  MASK 

HJB  r  -JB 

ICCTCUB)  t  SHIFTdJCCCr.NJB) 


DCCCNW 

DCCCMW 

DCCChV 

DCOCtt' 

DCCCNW 

DCCCNW 

DCCCNW 

Dca.-w 

ococww 

DCCCNW 

CCCtrW 

CCOINW 

DCCCNW 

DCCCNW 

DCCCNW 

UOCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

GECMTY 

GECMTY 

GECMTY 

GECMTY 

GECMTY 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 

DCCCNW 


00002 
00005 
0300* 
Ci j'.rjT 
00006 
OOCQ7 

ooooa 

OOGG9 
00010 
0001 1 
00012 
00013 
0C014 
00015 
00016 
00017 
00018 
00019 
00020 
00002 
00003 
00004 
00005 
00006 
00022 
00023 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
0G032 
00033 
00034 
00035 
00036 
00057 
00033 
00039 
OOG40 
00041 
000«2 
00043 
00044 
00045 
00046 
00047 
00048 


IB  =  IB  ♦  1 

DCOCNW 

00055 

toco 

CONTINUE 

DCOCNW 

COO  5  6 

GO  TO  3000 

DCOCNW 

00057 

c 

DCOCNW 

00058 

c 

PROGRAM  WILL  RETRIEVE  NJ  BOXES  PR  CM  CHORD  J 

DCCONW 

00059 

non 

CONTINUE 

DCOCNW 

00060 

JSB  =  (J-D/NBWID  ♦  1 

DCOCNW 

00061 

JB  =  (fCVRC  -  MCCU.teW'D)  )  *  3 

DCOCNW 

00062 

IFOB.E0.60)  JB  =  0 

DCOCNW 

00063 

IJMASK  =  SHIFT  (MASKi JB) 

DCCCNU 

00064 

NJB  =  -JB 

DCOCNW 

00065 

IT  2000  II  =  1 ,  IEtC,  ISKI P 

DCOCNW 

00066 

IJWQRD  s  IBOXdl ,  JSB) 

DCOCNW 

00067 

IJCCOE  =  I JWCRD.  AtC.  IJMASK 

DCOCNW 

00066 

I  CODE  (IB)  =  SHIFT  (I  JCCCEiNJB) 

DCOCNW 

00069 

IB  =  18  ♦  1 

DCOCNW 

00070 

2000 

CCKTINUE 

DCCONW 

00071 

C 

DCOCNW 

00072 

3000 

CONTINUE 

DCOCNW 

00073 

RETURN 

DCOCNW 

00074 

EtC 

DCOCNW 

00075 

B 165 


SUBROUTINE  POINTS  (  IX, MX,  MYB,  SUBD,  CUW,  IBOX.LBXCD, 

POINTR 

00002 

1  M*IR,  |PC*NT,IPNTIN,IPNTR  ) 

PCINTR 

00003 

c 

POINTR 

00004 

c 

GETCRATES  A  POINTER  ARRAY  VHICH  SERVES  AS  AN  I(CE X  TO  A 

POINTR 

00005 

c 

CC*CE»«ED  ARRAY  OF  BOX  VALUES  (MODES,  COMMA SHES.  ETC.) 

POINTR 

OOOG6 

c 

POINTR 

00007 

c 

IX  =  CENTER  OF  FIRST  BOX  TO  USE 

POINTR 

00008 

c 

MX  =  NUKJtR  OF  ROC  TO  PROCESS 

POINTR 

00009 

c 

MYB  =  MAXI  MIX  RCW  LENGTH 

POINTR 

00010 

c 

SUBC  =  .T.,  SUBCIVIDEC  BOXES  YO  BE  USED 

POINTR 

00011 

c 

=  .F..  UNSUBCl  VICED  BOXES  TO  BE  USEE 

POINTR 

00012 

c 

EIAfH  =  .T.,CIAfHKACMS  TO  BE  INCLUDED 

POINTR 

00013 

=  .F.,  CNLY  PLANfCRM  BOXES 

POINTR 

00014 

c 

I  BOX  =  ARRAY  OF  BOX  CODES 

POINTR 

00015 

c 

LBXCC  =  ROW  DIMENSION  C F  BOX  CODES  ARRAY 

POINTR 

□0016 

c 

MXIR  =  SIZE  OF  IPNTR  ARRAY 

POINTR 

00017 

c 

I PC* NT  =  VAUE  TO  BE  USED  FCR  FIRST  POINTER  (NORMALLY  1) 

POINTR 

U0018 

c 

HVOUT  - 

POINTR 

00019 

c 

IPNTIN  =  LOCATION  CF  NEXT  AVAILABLE  LOCATION  IN  IPNTR  ARRAY 

POINTR 

00020 

c 

(OVERLAP  OF  TAIL  IS  ACCOUNTED  FOR  HERE.) 

POINTR 

00021 

c 

am  puts  - 

POINTR 

00022 

c 

IPNTR  =  POINTER  ARRAY  -  OUTPUT  PR  CM  THE  SUER  OUT  I  PC 

KXNTR 

00023 

c 

IPNTR  <1 , 1 )  =  LOCATION  CF  THE  FIRST  VALUE  FCR  ROW  I 

POINTR 

Q0G24 

c 

IPNTR(2,I)  -  CHORD  LOCATION  (SUBSCRIPT  J)  CF  THAT  VALUE 

POINTR 

00025 

c 

POINTR 

00026 

c 

CCK<JN  VALUES  USEE  - 

PCINTR 

00027 

c 

POINTR 

00028 

c 

POINTR 

00029 

CIPCWION  IBOX(LBXCD.l),  IPNTRC2,1>,  ICCCEII5C) 

POINTR 

00030 

IOUICAL  CIATH.  SUED,  WING 

POINTR 

00031 

c 

POINTR 

00032 

1TCRBX  r  I  PC*  NT 

PCINTR 

00033 

IL  =  IX  ♦  MX  -  1 

POINTR 

00034 

DO  100  I ROW  =  I X,  IL 

POINTR 

OOG35 

IPBSU^O 

POINTR 

00036 

iusupro 

POINTR 

00037 

IPBX=1 

POINTR 

00038 

IBXSUM  i  0 

POINTR 

00039 

CALL  DCCCERUBCX. LBXCC,  IfiOW.l,  IROW.MYB,  SUBD,  ICCDE) 

POINTR 

0CO40 

c 

POINTR 

00041 

c 

FIND  LAST  BOX  cn  ROW 

POINTR 

00042 

M  =  HYD 

POINTR 

000 a  3 

IF  (CIAPH)  GO  TO  20 

POINTR 

00044 

c 

CM.Y  HLAPfCRM  BOXES  DESIRED 

POINT* 

00045 

do  is  jca_  =  i  ,myb 

POIN.R 

00046 

IF  (ICCCE(M)  .Efl.  1)  GO  TO  30 

POINTR 

00047 

M  =  M  -  t 

POINTR 

00048 

IS  CONTINUE 

POINTR 

00049 

GO  TO  92 

POINTR 

00050 

c 

PLhPTCRM  AND  DIAPHRAGM  DESIRED 

POINTR 

00051 

20  CONTIMJE 

POINTR 

00052 

DC  2  -•  4CCL  =  1  ,WTB 

POINTR 

00053 

IF  <ICCCF(M)  ,P€.  0)  GO  TO  30 

PCINTR 

00054 

M  =  M  -  t 

POINTR 

00055 

23  CONTINUE 

POINTR 

00056 

GO  TO  92 

POINTR 

00057 

c 

POINT* 

00058 

B1A6 


c  LOOP  ON  CHCRCS  IN  WE  RCW 

30  CONTINUE 

DO  90  JCCL  =  l.M 
IF  tlCCCE(JCCL)  -  1)  35,40,50 

C 

C  I  CODE  =  0 

C 

35  IF(IBISUM.NE.O)  GO  TO  40 
IPBX  =  IPBX  ♦  1 
GO  TO  90 
C 

c  ICCCE  =  1 

40  IPBSUH  =  1 21  SIX  ♦  1 
C 

c  ICCCE  =  2  CR  3 

SO  CONTINUE 

IDISUM  =  IDISUM  ♦  1 
90  CONTI  NLC 
C 

9e  CONTINUE 

IPNTO(l.IPNTIN)  =  ITOTBX 
ipnw(2,ipntin)  =  irex 
1PNTIN  =  HOOCIPNTIN.MXIR)  ♦  1 
iF(DIAfH)  GO  TO  95 
ITOTBX  "  ITOTBX  ♦  I  PBS  IX 
GO  TO  100 

95  ITOTBX  =ITOTBX  ♦  1  Cl  SIX 
100  CONTINUE 

IPNTR  (1  ,IFN,  lN)  3  ITOTBX 
IPNTR  (2,IPNTIN1  =  0 
RETURN 
DC 


POINTR  00059 
POINTR  00060 
POINTR  00061 
POINTR  00062 
POINTR  00063 
POINTR  00064 
POINTR  00065 
POINTR  00066 
POINTR  00067 
POINTR  00068 
POINTR  00069 
POINTR  00070 
POINTR  00071 
POINTR  00072 
POINTR  00073 
POINTR  00074 
POINTP  00075 
POINTR  00076 
POINTR  00077 
POINTR  00078 
POINTR  00079 
POINTR  0008C 
POINTR  00081 
POINTR  00082 
POINTR  00083 
POINTR  00084 
POINTR  00085 
POINTR  00086 
PdNTR  00087 
POINTR  00088 
POINTR  00089 
POINTR  00090 
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fun: not  loc$cw< tftcw.  jccl > I pntsd ■  I  pnti  n, j pmtot ■  i pntls) 

LOCSDW 

00002 

c 

LOCSDW 

00003 

c 

return  we  location  cf  we  word  in  we  ek>-around  subdivided 

LOCSDW 

00004 

c 

COUNWASH  ARRAY  CORRESPONDING  TO  BOXdRCR  JCCL)  CF  WE  5U6- 

LOCSDW 

00005 

c 

DIVIDEC  BOX  ARRAY 

LOCSDW 

00006 

c 

LOCSDW 

00007 

c 

IRCW  -  BOX  CHCRCWISE  LOCATION 

LOCSDW 

00000 

c 

jca  =  BOX  SPANWISe  LOCATION 

LOLSCW 

00009 

c 

IPNTSD  =  ARRAY  OF  POINTERS 

LOCSDW 

00010 

c 

IPNTIN  =  NEXT  AVAILABLE  (UNUSED)  CELL  IN  IPNTSD  (Ef€- 

LOCSDW 

00011 

c 

AROLtC) 

LOCSDW 

00012 

c 

IPNTOT  =  FIRST  CURRENTLY  AVAILABLE  CELL  IN  IPNTSD 

LOCSDW 

00013 

c 

I PNTLS  ~  LAST  CEU.  CF  IPNTSD  (LENGTH  CF  ARRAY) 

LOCSDW 

00014 

c 

RETURN  - 

LOCSDW 

0C015 

c 

LOCSDW  -  LOCATION  CF  DESIRED  DOWNWASH,  IF  SUCCESSFUL 

LOCSDW 

00016 

c 

=  0,  IF  LOCPNT  LIES  OUTS  IDE  WE  DEFINED  AREA. 

LOCSDW 

00017 

c 

LOCSDW 

00018 

CIACNSICN  IPNTSD (2,1  PNTLS) 

LOCSDW 

00019 

c 

LOCSDW 

00020 

LOCPNT  =  HOC  ( IRCW- 1, 1  PNTLS'  ♦  1 

LOCSDW 

00021 

c 

LOCPNT  -  LOCATION  C*  CELL  IN  IPNTSD  WHICH  VAS  CR  IS  TO  BE  LOCSDW 

00022 

c 

USED 

1.0CSCW 

00023 

IF  (I PNTI N  -  IPNTOT)  100  ,  300  ,  200 

LOCSDW 

00024 

c 

END  AROUND  HAS  OCCURRED 

LOCSDW 

00025 

100 

IF  (LOCPNT  -  IPNTIN)  400  ,  300,  150 

LOCSDW 

00026 

c 

NOT  IN  UPPER  FART.  IS  LOCPNT  WIWIN  BOTTOM  PART  - 

LOCSDW 

00027 

ISO 

IF  (LOCPNT  -  IPNTOT)  300  ,  400  ,  400 

LOCSDW 

0GO28 

c 

LOCSDW 

00029 

c 

NO  ENC  AROJND,  AXRHU.  SEQUENCE 

LOCSDW 

00030 

aoo 

IF  (LOCPNT  -  n^TTIN)  250  ,  300  ,  300 

LOCSDW 

00031 

c 

LESS  WAN  UPPER  LIMIT.  IS  LOCFNT  .OE.  LOWER  LIMIT  - 

LOCSDW 

00032 

c50 

IP  (LUCFNT  .OE.  IFNTOI)  CO  TO  400 

LOCSDW 

00033 

c 

LOCSDW 

00034 

c 

ERROR  CR  INITIAL  CCfCITICN  ENCOUNTERED  (SHOULD  NEVER  OCCUR) 

LOCSDW 

00035 

300 

LOCSDW  =  0 

LOCSDW 

00036 

00  TO  500 

LOCSDW 

00037 

c 

LOCSDW 

00018 

c 

SUCCESSFUL,  BOX  HAS  BEEN  DETINEI 

LOCSDW 

00019 

400 

IFB  =  IFNTSC  (2,  LOCFNT) 

LOCSDW 

00040 

iruca.LT.IFB)  OO  TO  300 

LOCSDW 

00041 

LOCSDW  =  IPNTSCa, LOCFNT)  ♦  jca-iPD 

LOCSDW 

0TO42 

c 

LCCSDW 

00043 

wo 

CONTINUE 

LOCSDW 

00044 

RETURN 

LOCSDW 

00045 

ETC 

LCCSCV 

00046 

B 1 68 


SUBROUTINE  SMPLWI  IBOX.LBXCD,  JCHRC,  JT,  IPRST.luAST) 

SMPLW 

c 

SMPLW 

c 

COMPUTES  DOMMASH,  SICEVASH  AM)  VELOCITY  POTENTIAL  FOR  A 

SMPLW 

c 

SAMPLE  CHORD  LOCATED  IN  THE  WING  FLOW  Ft  ELD 

SMPLW 

c 

SMPLW 

c 

I  box 

=  ARRAY  OF  BOX  CODES  FOR  THE  WING 

SMPLW 

c 

LBXCD 

=  LENGTH  CF  BOX  code  ARRAY 

SMPLW 

c 

JCHRD 

=  SAMFLE-VRSH  CHORD  NUfCER 

SMfLW 

c 

JT 

=  J-LOCATION  CF  THE  CHORD 

SMPLW 

c 

IFRST 

=  NUPCER  CF  RRST  SAMPLE  BOX 

SMfLW 

c 

ILAST 

=  NUFCER  OF  UST  SAMPLE  BOX 

SMPLW 

c 

SMfLW 

DIMENSION  IBOX(LBXCC.l) 

SMfLW 

COWON  /CCNTRL/ 

FREVEX.CHACH,  TITLE  <8> ,  BRVGECM, TRVMOCE, DIHW, DIHT, 

CONTRL 

t  DEFAULT  CCNTKL 

LOGICAL  RRVGECM,  BiVMCCE.  DIHW,  DIHT  i  DEFAULT  CONTRL 

COWCN  /fRCBLN/  XMACH ,  N4XES , NTSLCF ,  VAVALS , SMOOtH ,  NDEG, CRDFI T ,  PRQBLM 

t  EXAICiSURCV,  R.YWXC  fRCBLM 

LOGICAL  SMOOTH ,  CRDFI  T.EXA  I C ,  SUBDV ,  H.YWXC  PRC8LM 

COWCN  /SNUASH/  I PNTSD 12 , 50 ) ,  ENSURD<2,600> ,  IPNTIN,  IPNTOT,  I PNTLS  SMASH 
C  1  PNTSD  (LPNTSD)  •  ENSUED  <2*LSDW>  SMASH 


C 

c 


COMPLEX  ENSUED 

COWCN  /MUAICS/  YRAR,EL,MUAIC(2i  50)  ,NICWS,SURF, 

1  TBARL.ELL.  MUAICL(2,50>  ,  NIOWSL.SIRFI,  PSI  DIF 

LOGICAL  SURF, SIR FL 

COWCN  /GECMTY/  CCFLAN,  NSUCCV ,  XSUBCV,  NSUBC2 ,  N5U8CN,  NSLRF , 

1  B1  iBIBETA  i  BIS.BIBTAS.ULAX,  VLAZ,  PSIW, 

2  MXBW,  MXBBW,  MTBWi  MTBBW-  MXESW,  Mf  CSW,  Mi'BBSW, 

3  IXBW.XCENTR 
LOGICAL  COPLAN 

COWON /RUES  /  MT5,NT6,lNTAFE,IMf5P,NaAIC,NSFAIC,Na/TP, 

1  IOUF5P,MOCeSC,lVPSC,ICEC6C,lWTFSC,IAICSC 

COWGN  /IOCONT/  OPLAIC.CSPAIC.WTGECM, WIGNAF, WTSL.WTBL,  PRBCiC, 

1  RRRAIC.BiSAIC.FRMCCS.RRCCEF.HICW.HiSW.fRV?, 

2  BIBL.BjDCP.mCNAF.PRWAC.PRSL.FRLW.PRNW.FRCM 
EBUI  VALENCE  (PRUW.fRDW) 

LOGICAL  OfLAIC.CSPAIC.WTGECM.WrCNAF.WTSL.WTBL.FRBOX.FRFAIC, 
t  fRSAIC,  PRMCCS ,  PRCOEF:  FRDW,  PRSW,  FRVP,  PRBL ,  FRSL ,  FRGWF, 

2  f*DCP,FRGNACif*UW,FRLW,B<NW,fRCM 

COMMON  /  MCCES/  SYM,5YKT,MTYPEW,MTYPET 

COWCN /NWASHES/  IPNTUW2.100)  ,EN<US  (12?5) ,  EN<1$(1275)  ,10/LAFN 
COMPLEX  EWUS,  EMILS 

COWON  /A ICS  /  WYL.  CH64C)  ,W(1640) ,  V!1640> 

COMPLEX  C,  W,  V 

COMPLEX  EWi52>  ,SW(50)  ,LW(50) ,  fHI  (50) 

C?UI  VALENCE  (SW.1PNTSD) ,  (LW,  ENSUED) ,  (DW,  ENSUED (1 ,26) ) 

EBUI  VALENCE  (PHI  .ENSUED (1 , 52) ) 

or  ,rx  veuN.vsuM.misuM,  en 

iK.twCR  RWT.LWT 
DATA  RWT.LWT  /  3,4  / 

SET  CONSTANTS 
Cni  *  CCS  (PS I W) 

*P»I  *  »!N<PSIW> 


SMASH 

MUAICS 

MUAICS 

MUAICS 

GECMTY 

CECMTY 

GECMTY 

GECMTY 

GECMTY 

files 

files 

IOCCKT 

IOCONT 

BCSFRB 

IOCONT 

IOCONT 

IOCONT 

BCSFRB 

MCOCCM 

MASHES 

MASHES 

AICS 

AICS 

SMPLW 

SMPLW 

SMPLW 

SMPLW 

SMPLW 

SMPLW 

SMPLW 

SMfLW 

AMPLW 

SMPLW 


BINV  z  1 ./Bl 
C 

<  COMPUTE  WE  RIGHT  WING  CONTRIBUTION  TO  THE  SAMPLE  CHORD 


SMPLW 

SMPLW 

SMPLW 


00002 
00003 
00004 
GOOOS 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
□0014 
00002 
00003 
00004 
00002 
00003 
0QC04 
00002 
00003 
00004 
00002 
00003 
00004 
00002 
00003 
00004 
00005 
00006 
00002 
00003 
00002 
U0O03 
00001 
00005 
00006 
00007 
00002 
00002 
00002 
00003 
00002 
00003 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
C0032 
00033 
00034 
00035 
00036 
000 3 T 


3169 


c 

SHPLW 

00033 

c 

GET  THE  ACCESSARY  AIC  ARRAY 3 

SMPLW 

00039 

CALL  GETAIC  ( JO*C,RWT ,  0,  IR) 

$K*LW 

00040 

IP  (IR  .1C.  0>  GO  TO  800 

SMPLW 

00041 

YHUBAR  =  «  JT-  .5  ♦  EL*SPSI)  /  CPSI 

SKPLW 

00042 

JBAR  =  YMJBAR 

SHPLW 

00043 

IP  (YMUBAF  .GE.  0)  JBAR  =  JBAR  ♦  1 

SHPLW 

00044 

NU6HIN  =  ABS(EL)  ♦  .5 

SMPLW 

00045 

IBX  =  1 

SHPLW 

00046 

c 

3MR.W 

00047 

c 

LOOP  CN  BOXES  ALONG  THE  SAMPLE  CHORD 

SHPLW 

00048 

DO  200  IBXS  =  IPRST .  ILAST 

SHPLW 

00049 

MJBMAX  =  ICXX  ~1 

SMPLW 

00050 

I  =  IBXX  -  NbBMlN 

SHPLW 

OOC51 

c 

SHPLW 

00052 

c 

ZERO  OUT  THE  SUMMATION  VARIABLES 

SHPLW 

00053 

WBUM  -  XI. ,0.) 

SHPLW 

ax:  54 

VSUM  =  (0.,0.) 

SHPLW 

00055 

PHI  SUN  =  (0.,0.) 

SHPLW 

00056 

c 

SHPLW 

00057 

IP  (YEAR)  120,125,130 

SHPLW 

0CO58 

120 

1 

II 

g 

*-4 

“» 

SHPLW 

00059 

GO  TO  135 

SHPLW 

00030 

125 

IAIC  =  NUBMIN**2 

SMPLW 

00061 

1NCAIC  =  24NUBMIN  ♦  1 

SMPLW 

00062 

JINCR  =  1 

SHPLW 

DOG  S3 

GO  TO  140 

SHPLW 

00064 

130 

JINCR  =  1 

SHPLW 

00065 

135 

IAIC  =  NUBMINfctZ  ♦  MJEMI N 

SHPLW 

00066 

INCAIC  =  2*NL€MIN  ♦  2 

SHPLW 

00067 

140 

CONTINUE 

SHPLW 

00060 

c 

SHPLW 

00069 

c 

LOOP  FCRV4ARC  ONER  THE  RIGHT  WING 

SHPLW 

00070 

DO  190  NU6AR  =  NJEMi  N,  NU3MAX 

SMPLW 

00071 

MUAIC1  =  HUAIC(1 ,  NUBAR^i  ) 

SMPLW 

00072 

KJAIC2  =  HUAIC  (?,  HJE4RM ) 

SMPLW 

00073 

IP  (NUAIC2  .Ea.  0)  GO  TO  185 

SMPLW 

00074 

IP  (Y3AR  .GE.  0)  GO  TO  150 

SHPLW 

00075 

JCCU?  =  JBAR  ♦  NUBAK  -  HUAIC2  ♦  t 

SMPLW 

00076 

GO  TO  ISO 

SMPLW 

00077 

150 

JCOR  -  JBAR  -  NUBAR  ♦  HUAI  Cl  -  1 

SMPLW 

00078 

ieo 

CONTINUE 

SHPLW 

OOnx., 

c 

SMPLW 

00080 

c 

LOOP  ON  A  ROW  CP  WING  BOXES,  COMPUTING  RIGHT  WING  CONTRIBUTION  SMPLW 

00081 

DO  ISO  HUAI  =  MUAIC1.HUAIC2 

SMPt  W 

00082 

•F  (JCCLR  .LE.  0)  GO  TO  1  TO 

SMPLW 

00083 

CAU.  DCOCERdBOX.LBXCD.  l.JCCLR,  I, JCOR,  .F.,  ICD) 

SMPLW 

00084 

IP  (ICD  .ED.  0)  CO  TO  1TO 

SHPLW 

00085 

c 

A  CONTRIBUTING  BOX  HAS  BEEN  POUND.  GET  THE  AIC  LOCATION 

SMfLW 

00086 

MIC  =  IATC  *  HU*: 

SMPLW 

00087 

c 

GET  THE  NCR  HAL-WASH  LOCATION 

SHPLW 

00088 

IDS  =  10CSCW(  I ,  JCCLR  ,  I  PNTCW.LPNTCW,  1,  LPNTDV) 

SHPLW 

00089 

c 

ACL  THIS  COHTRIBUnON  t0  THE  SUMS 

SHLW 

00090 

IP  (a  .LT.  0)  GO  TO  163 

SMFLW 

0009! 

EH  =  ENRUStiCS) 

SMPLW 

00092 

GO  TO  165 

SMFLW 

00093 

163 

£N  =  EWH.3(irSI 

SHPLW 

00094 

8170 


u  u 


161  CONTI  HUE 

WSUM  a  WSUM  4  W(KAIC)  *  EN 

VSUK  =  V3UM  4  V(KAIC)  *  EN 

FHISUM  =  WISUN  4  CIKAIC)  *  EN 
170  CCNTINJE 

JCCLR  =  JCCLR  4  JINCR 
100  CONTINUE 

C  EH)  CF  LOOP  FCR  RICHT  WING  ROW  CONTRiaUTlOB 

C 

185  CONTINUE 
1  =  1-1 

IF  <!  .LE.  0)  CO  TO  195 
IAIC  =  IAIC  4  I  MCA I C 
INCAIC  =  INCAIC  4  2 
190  CONTINUE 

EM)  CF  LOOP  FCRVARC  ON  RICHT  WTNC  ROMS,  FRCM  140* 

193  CONTINUE 

CWUBXJ  =  BINV  «  <CPSI*6UM  +  SPSI*VSUM> 

SU(IBX)  =  BUN  *  (CPSUVSUH  -  SPSI 4W5UH) 

PHI  (IBX)  =  PH  I  SUM 
IBX  =  IBX  4  1 
200  CONTINUE 

C  EH)  CF  LOOP  ON  RECEIVING  BOXES,  FOR  RIGHT  WING  CONTRIBUTIONS 

C 

texs  =  ibx  -  l 

C  IS  left  wing  contribution  pceeed  - 

IF  (SYM  .EB.  0)  GO  TO  310 

C  YES.  GET  THE  AIC  ARRAYS  FCR  LEFT  WING  CONTRIBUTION. 

CALL  GETAICOCHRD,  LWT ,  0,  IR) 

IF  HR  .NE.  0)  GO  TO  BOO 
NJBMIN  a  ABS(EL)  4  .5 
IBX  a  1 

YMUBAR  =  (-JT+.5  4  EL*SFSI)  /  CPSI 
JBAR  =  YMUBAR 

IF  (YMUBAR  .GE.  0)  JBAR  =  JBAR  4  1 
C  LOOP  ON  BOXES  ALONG  THE  SAMPLE  OfCRD 

00  300  IBXX  a  IFRbT ,  I  LAST 
MBMAX  =  IBXX  -  1 
I  a  IBXX  -  NUBMIN 

C  ZERO  CLT  THE  SUMMATION  VARIABLES 

WSUM  =  (0.,0.) 

V5UM  a  (0.,0  ) 

MU  SUM  =  <0.,0.> 

C 

IF  (YBAR)  220,225,230 
220  JINCR  a  1 
GO  TO  235 

225  IAIC  =  MUBMINW® 

INCAIC  a  2*MJBMIN  4  1 
JINCR  =  -1 
GO  TO  240 
230  JINCR  =  -1 
235  IAIC  a  NU0MIM**2  *  NUBMIN 
INCAIC  =  24MX)MtN  ♦  2 
240  CONTINUE 
C 


SMPLW  00095 
SMPLW  00096 
SMPLW  00097 
SMPLW  00098 
SMPLW  00099 
SMPLW  00100 
SMPLW  00101 
SMPLW  00102 
SMPLW  00103 
SMPLW  0C1O4 
SI*LW  00105 
SMPLW  00106 
SMPLW  00107 
SMPLW  00108 
SMPLW  00109 
SMPLW  00110 
SMPLW  00111 
SMPLW  00112 
SMPLW  00113 
SMPLW  00114 
SMPLW  00115 
SMPLW  00116 
SMPLW  (Ml  17 
SMFLW  00118 
SMPLW  00119 
SMPLW  00120 
SMPLW  00121 
SMPLW  00122 
SMPLW  00123 
SMFLW  00124 
SMPLW  00125 
SMPLW  00126 
SMPLW  00127 
SMPLW  00128 
SMPLW  00129 
SMPLW  00130 
SMPLW  00131 
SMPLW  00132 
SMPLW  00133 
SMPLW  00134 
SMPLW  00135 
SMPLW  00136 
SMPLW  00137 
SMPLW  00138 
SMPLW  00139 
SMPLW  00140 
SMPLW  00141 
SMPLW  00142 
SMPLW  00143 
SMPLW  00144 
SMPLW  00145 
SMPLW  00146 
SMILW  00147 
SMPLW  00148 
SMPLW  00149 
SMPLW  00)  50 
SMPLW  00151 


c 

LOCP  FORWARD  OVER  THE  LEFT  WING 

SMPLW 

00152 

00  290  NUBAR  =  NUBMIN.NUBHAX 

SMPLW 

00153 

MUAIC1  =  MUAIC(l.NUBArtM) 

SMPLW 

00154 

MUAIC2  :  KiAIC(2>‘-*JBAR+l> 

SMPLW 

00155 

IF  (MUAIC2  .LE.  0)  CO  TO  285 

SMfLW 

00156 

IF  (YBAR  .CE.  0>  CO  TO  250 

SMPLW 

00157 

JCCLL  =  J3AR  -NLBAR  ♦KMIC1  -1 

SMPLW 

00158 

CO  TO  260 

SMPLW 

00159 

250 

JCat  =  JBAR  +NUBAR  -MUM Cl  *1 

SMPLW 

00160 

260 

CONTINUE 

SMFLW 

00161 

C 

SMPLW 

00162 

c 

LOOP  ON  A  HOW  CF  WINC  BOXES,  COM  PUT  I  NO  LEFT  W!NC  CONTRIBUTIONS  SMPLW 

00163 

DO  200  HUAI  =  MUAIC1  .MUAIC2 

SMPLW 

00164 

IF  (JCCLL  .LE.  0)  CO  TO  2TO 

SMPLW 

00165 

CALL  DCCCERdBOX.LBXCC,  I.JCaL,  I, JCCLL,  .F.,  ICC) 

SMPLW 

00166 

IF  < I CD  . ED .  0)  CO  TO  27Q 

SMPLW 

00167 

c 

A  CONTRIBUTING  BOX  HAS  BEEN  FOUND.  CET  THE  AIC  LOCATION 

SMPLW 

00168 

MIC  =  I AIC  ♦  MUAI 

SMPLW 

00169 

c 

err  THE  NCRMAL-WASH  LOCATION 

SMFLW 

00170 

IDG  =  lOCSDW(  I ,  JCCLL,  IFNTCW,  LPNTDW,  1,  LPNTDW) 

SMPLW 

00171 

c 

ADD  THIS  CONTRIBUTION  TO  THE  SUMS 

SMPLW 

00172 

IF  (EL  .LT.  0)  CO  TO  263 

SMFLW 

00173 

EN  =  EJEUS  (IDS) 

SMFLW 

0G1 74 

CO  TO  265 

SMPLW 

00175 

20 

EN  =  ETRLS(ICS) 

SMFLW 

00176 

265 

CONTINUE 

SMPLW 

00177 

V6UU  =  V6UM  ♦  W(KAIC  *  EN 

SMFLW 

00178 

VSUN  =  VSUH  ♦  V(KAIC)  *  EN 

SMPLW 

00179 

fHISUM  =  EH I SUM  ♦  COCAIC)  *  EN 

SMFLW 

00180 

270  CCNTINUE 

SMPLW 

00181 

JCCLL  =  JCCLL  ♦  JINCR 

SMFLW 

00182 

200 

CONTINUE 

SMPLW 

00183 

C 

ETC  CF  LOOP  FCR  LEFT  WINC  ROW  CONTRIBUTIONS 

SMFLW 

00184 

C 

SMPLW 

00185 

205 

CCNTINUE 

SMPLW 

00186 

1  =  1-1 

SMPLW 

00187 

IF  (I  .'_E.  0)  CO  TO  295 

SMPLW 

00188 

IAIC  =  I  AIC  ♦  INCAIC 

SMPLW 

00189 

INCAIC  =  INCAIC  ♦  2 

SMFLW 

00190 

290 

CCNTINUE 

SMFLW 

00191 

C 

ETC  CF  LOOP  FORWARD  CN  LEFT  WINC  R0u6,  FROM  240 

SMPLW 

00192 

C 

SMFLW 

00193 

C 

SMFLW 

00194 

295  CONTINUE 

SMPLW 

00195 

CW(IBX)  =  CW(IBX)  ♦  BINV*(CPSI*A€UM  -  SPSI *VSUM)  *  SYM 

SMPLW 

00196 

SW(IBX)  r  SW(IBX)  ♦  BINV*(CPS!*VSUM  ♦  SPSI 4WSUM)  A  SYM 

SMPLW 

00197 

»HI(IBX)  =  FHKIBX)  ♦  PH!SUH*SYM 

SMPLW 

00198 

IBX  :  IBX  ♦  1 

SMPLW 

00199 

300 

CONTINUE 

SMPLW 

00200 

C 

ETC  OF  LOOP  ON  RECEIVING  BOXES,  FCR  LEFT  WINC  CONTRIBUTION 

SMPLW 

00201 

c 

SMPLW 

00202 

c 

DETERMINE  WiAT  TO  PRINT 

SMPLW 

00203 

MO 

CCNTINUE 

SMPLW 

00204 

WUTE  (NT6, 6001 )  TITLE,  XMACH.7XVL,  JT,  IFRST.ILAST 

SMPLW 

00205 

IF  (.NO)  .  PROW)  CO  TO  330 

SMPLW 

00206 

WUTC  (NT6,60tP 

SMPLW 

00207 

WilTC  (NT6,  €01  j  ,  (CW'O  )  ,  I  =  I.TCXS) 

SMPLW 

00208 

B172 


330  CONTI MJE  SMfLW 

IF  I. NOT .  IRSW)  GO  TO  340  SMFLW 

VRITE  < NTS, €011 )  SMFLW 

WilTE  (NT6t 6013)  <SW<t),I  =  1,)CXS>  SMFLW 

340  CCNTIMJE  SMFLW 

IF  (  .NOT .  BRLW)  CO  TO  400  SMFLW 

IF  OCXS  .LT.  2)  CO  TO  400  SMFLW 

I  sue  =  0  SMFLW 

WIUSUB)  =  2.*FH1<1)  -  MI  (2)  SMFLW 

wt<Fexs+i)  =  2.*«hi ()*xs)  -  fhiifcxs-i)  smflw 

FACTOR  =  B1  BETA/2.0  *  BINV**2  SMFLW 

DO  350  I  =  1,F«XS  SMFLW 

LW(I)  =  FACTOR* <WI  tl*i)  -  FHIU-l))  SMFLW 

310  CONTINUE  SMFLW 

WJITE  (NTBi 6012)  SMFLW 

WilTE  (NT6, 6013)  (LWII ) ,  1=1 , FCXS)  SMFLW 

C  SMFLW 

400  RETURN  SMFLW 

C  SMFLW 

BOO  tfilTC  (NTS, 0000)  IR  SMFLW 

GO  TO  400  SMFLW 

C  SMFLW 

6001  FCRMAT<IH1,20X,8A10/  51X,18HFLOWFIELD  SAMPLING  /40X.TVK  MACH  ,  SMFLW 

1  F5.3,5X,12HREB.  FRQ).  =,F8.5,  2H  )/  41X.16HSAMPLED  AT  CHORD  SM<LW 

2  13,  W,  BOX  12.  BH  TO  BOX  12  /  1H0.2X,  4(10X,4FREALi8X,  SMfLW 

3  9HI  MAGI  NARY)  )  SMFLW 

8010  FORMAT  (15H0  UP-WASHES  -  )  SMFLW 

8011  FORMAT  <1 5HJSI CE-WASHE5  -  )  SMFLW 

8012  FCRMAT  (22H3LCNGI TUD I NAL- WASHES  -  )  SMFLW 

8013  FCRHAT(4X,8E16.8)  SMFLW 

C  SMFLW 

8000  FCRMAT (54K3***  WARNING  -  PROBLEMS  ENCOUNTERED  WHILE  GETTING  AICS  SMFLW 
1  39M  FCR  FLOW- FI  ELD  SAMPLING.  ERROR  CCCE  =  ,15,  4H  ***  >  SMFLW 

DC  SMFLW 


00209 
00210 
00211 
00212 
00213 
00214 
00215 
00216 
0021 7 
00218 
00219 
00220 
00221 
00222 
00223 
00224 
00225 
00226 
0022? 
00228 
00229 
00230 
00231 
00232 
00233 
00234 
00235 
00236 
0023? 
00238 
00239 
00240 
00241 
00242 


8173 


c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


PROGRAM  SHTH 

THsS  FROCRAM  WILL  PIT  A  LEAST  SQUARES  POLYNOMIAL  SURFACE 
TFRCUCH  THE  VELOCITY  POTENTIALS  FCR  A  FLAtTCRM.  A  fCW  SET  OF 
VELOCITY  POTENTIALS  WILL  BE  CALCULATED  FROM  THE  POLYNOMIALS 
AfC  WRITTEN  CN  THE  IVPSC  FILE. 


CO*«N  /ARRAYS/  KBXCbV.LBXCCW.LBOXC.KBXCDT.LBXCDT.KJALFH.LJALFH, 

1  RALfHA,KR£RN.,LKERN.,KPNTRM,LPNTRM,KDEFSL,RELFHI , 

2  LMCCE5,KPNTSB,LPNTSD,KSBW,LSDW,KPNTBW,LPNTCW, 

5  r,BW,LDW,KTVP,LTVP 

CO440N  /FILES  /  NTS, NT6, INTAPE, IffSP,NaAIC,N5PAIC,N3UTP, 

1  IOUFSP.MCCESC, IVPSC, lOECSC.lWTFSC.IAICSC 

COMMON  /IOCCNT/  OR_AlC,C6PAIC,WTGECM,WTGNAF,WTSL»WTBL»R5BOX, 

1  PRPAIC,  IRSAIC,  FRMOCS,  FRCCEF,  FRDW,  FRSW,  PRVP, 

2  fRBL,FRDCP,fRCNAF,FRGNAC,PRSL,FRLW,FRMrf,FRCM 
fflUI  VALENCE  (FRCAV.FRDW) 

LOCI  CAL  OPLAIC,CSFAIC,WTC€CN,WTGN*.F,WrSL,WTBL,FRBOX,PRFAIC, 

1  PRSAIC.FRMCCR.FRCCEF.fRCV.FRSW,  FKVP.FRBL.IRSL.FRGNAF, 

2  FRDCP,PRO*AC,FR'JW,FRLW,FRf*J,PRCM 

ONON  /FRCBLM/  WACH,  fXXES , NTSLOP,  NC  VALS,  SMOOTH ,  NDEG,CRDFIT , 

1  EXAIC,SU0CV,FLYWOCr 

LOGICAL  SMOOTH, CRDFIT,EXAIC,SUBDV,*.YWOCE 

CCMCN  'KVAL  /  I KVAL ,  W  VaL  (20  > ,  WS(20> 

COHCN  /CECKTY/  COKAN,  NSUBDV ,  XSUBCV,  NSIJBC2 ,  NSUBCN,  NSURF , 

1  B1  ,B1  BETA,  BIS,  B1BTAS.VLAX,  VJLAZ,  PSIW, 

2  MXEW,  MXBBW,  MYBW,  MYBBW,  MXBSW,  HYBSW,  KTBBSW, 

5  IXBW.XCENTR 

LOGICAL  COPLAN 

COWCN  /GCOC  /  TLAX,TLAZ,F$IT,MXBT,MYBT,MYBBT,MXBST,MYBST, 

1  MYBB5T , I XBT , I XBST.CAFL 

CO*WN  /TAPElCy  FfS ,  FMS ,  LS ,  FPR ,  ID (20) , NI C, ITYPEiLRS,LWS,M, N, 

I  PARM(IO)  ,  IRR 

DIMEN5ICN  IFARM(IO) 

BIUI  VALENCE  (FARM,  I  FARM) 

CO*«N  /CHECK FR/  CPPCPR  ,  GEOCFR ,  MCCCFR ,  AICCIR  .  NW5C  FT. ,  SMC  IR  ,  GAFCPR 
LOGICAL  CPPCFR,  GEOCPR,  MCCCFR,  AICCFR  ,  NW5CFR ,  SMCFR ,  GAFCFR 
EQUI  VALENCE  (CHECK FR  ,  SMCFR  ) 

UOCICAL  CHECK  FR 

DELPHI  (►COKES)  ,  TVPINCCLS1  ♦  NCCLS2  *  N5LCDV) 
COMPLEX  DELPHI  (1000) ,  TVP(250> ,  AVPS(I250» 

X(FO .  DELPHI  ♦  HJ,  TVP),  Y  (SAME) 

complex  scelfh 

DIMENSION  XU250).  Y(12S0) 

A  (NO.  CCEFT , ) 

COMPLEX  A  (66) 


COMMON  /IFCEV  13(100)  ,  NCC(IOO)  ,  J5<100)  ,  JOC(IOO) 
XP(fC.  CCEFT.  ♦  1),  YP(SAME) 
DIMENSION  XP(ll),  YP(tl) 

FE«.OC  ( (Ml’BWMYBT)  ANSUBDV)  , 

DI*N5ICN  FEXIOC  (250)  , 

I  FtTTR  M  (2 ,  FROC  *N5  UB  D V ) 

DIMENSION  I  P)(TRM(2 ,1  50) 

DIMENSION  TITL  (5) 


TEXLOC(SAME) 

TEXL0C(250) 


ftnxi 

0006S 

SMOOTH 

00004 

SMOOTH 

00005 

SMOOTH 

oooos 

SMOOTH 

0000? 

SMOOTH 

00008 

SMOOTH 

00009 

ARRAYS 

00002 

ARRAYS 

00003 

ARRAYS 

00004 

ARRAYS 

00005 

FILES 

00002 

FILES 

00003 

IOCCNT 

00002 

IOCONT 

00003 

BCSFRB 

00001 

IOCONT 

00005 

IOCCNT 

00006 

IOCCNT 

000G? 

BCSFRB 

00002 

FRCBLM 

00002 

FRCBLM 

00003 

PRCBLM 

00004 

KVAL 

00002 

GECKTY 

00002 

GECHTY 

OCOG3 

GEGhTY 

00004 

GECHTY 

00005 

CECKTY 

00006 

G€02 

00002 

CEOC 

00003 

TAPEIO 

GOOG2 

TAPEIO 

00003 

TAPEIO 

00004 

TAPEIO 

00005 

CHECK  fR 

X0G2 

CHECK  PR 

0CGG3 

SMOOTH 

00020 

SMOOTH 

OOG21 

SMOOTH 

00C?2 

SMOOTH 

0002.' 

SMOOTH 

OGOL4 

SMOOTH 

00025 

SMOOTH 

0GO26 

SNO-.H 

0002? 

SMOOTH 

00028 

SMOOTH 

00029 

SMOOTH 

00030 

SMOOTH 

00031 

SMOOTH 

CC032 

SMOOTH 

00033 

SMOOTH 

00034 

SMOOTH 

00035 

SMOOTH 

00G3r 

SMOOTH 

0003? 

SMOOTH 

0003  < 

SMOOTH 

0003/ 
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REAL  HI 

SMOOTH 

00040 

COMPLEX  VP 

SMOOTH 

00041 

LCCICAL  MXREAD,MXV4UT,RAfCIN,RA>COU 

SMOOTH 

00042 

Kl  =  )*VAL<IKVAL) 

SMOor.-s 

0004  3 

MWCAC  =  .FALSE. 

SMOOTH 

00044 

RANC1N  =  .FALSE. 

SMOOTH 

00045 

HXWm  =  .FALSE. 

SMOOTH 

00046 

RAfCCU  =  .FALSE. 

SMOOTH 

0004? 

KXB  =  HXBW 

SMOOTH 

00048 

IF  (COPLAN)  MXB  =  MXBT 

SMOOTH 

00049 

c 

SMOOTH 

00050 

c 

SMOOTH 

00051 

c 

PUT  NAME  OF  SCRATCH  FILE  FCR  SMOOTH  CD  VALUES  INTO  RjkCE 

SMOOTH 

00052 

c 

SMOOTH 

00053 

♦CVPSC  =  TAICSC 

SMOOTH 

00054 

REMIND  NIVPSC 

SMOOTH 

00055 

c 

SMOOTH 

00056 

c 

GET  THE  PLA^QiH  POINTERS  FROM  THE  MCCESC  FILE 

SMOOTH 

00057 

c 

SMOOTH 

00058 

REMIND  MOD ESC 

SMOOTH 

00059 

CALL  RDINIT 

SMOOTH 

00060 

I  TYPE  =  5HMIXEE 

SMOOTH 

00061 

♦CARRY  =  6HIPNTRM 

SMOOTH 

00062 

CALL  REACMX(M0CESC,M*EAC,RAKCIN,>fS,T*e,LS.f*4;,2.NID,ln,ITYPE. 

SMOOTH 

00063 

1  LRS,IPNTRM,2,NPNTRS,FARM,IRR) 

SMOOTH 

00064 

IOVLAP  =  IFARH(3) 

SMOOTH 

00065 

IFCIRR.fC.O)  GO  TO  6020 

SMOOTH 

00066 

c 

SMOOTH 

0006? 

CALL  R Cl  NIT 

SMOOTH 

00066 

I  TYPE  =  5HMIXED 

SMOOTH 

00069 

tfSH 

SMOOTH 

OOOTO 

KXARRY  =  SHIS  PT. 

SMOOTH 

00071 

CALL  REACMX<MCCESC,M*<EAD,RATeiN,*f$,NMS,LS,>**,l.NID,IC,lTYPe. 

SMOOTH 

00072 

1  LRSt  IS,  M.  N,  FARM,  IRR) 

SMOOTH 

00073 

IF(II3i.«.0)  GO  TO  6020 

SMOOTH 

00074 

c 

SMOOTH 

00075 

c 

SMOOTH 

00076 

c 

READ  THE  FEXLOC  AT®  TEXLOC  ARRAYS  FROM  THE  GEOMETRY  SCRATCH 

SMOOTH 

00077 

c 

FILE.  THESE  ARE  NEEDED  TO  INTERPOLATE  VELOCITY  POTENTIALS  AT 

SMOOTH 

00078 

c 

BOK  EDGES. 

SMOOTH 

00079 

c 

SMOOTH 

00080 

REMIND  I cease 

SMOOTH 

00081 

CALL  RDINIT 

SMOOTH 

00082 

♦MS  -  2 

SMOOTH 

00083 

IF(NSURF.EQ.1.CR.CC*_AN)  ♦*$=! 

SMOOTH 

00084 

I  TYPE  =  5HMIXED 

SMOOTH 

00085 

KXARRY  =  6hFE*L0C 

SMOOTH 

00086 

CALL  READMXUCEQSC.MWEAD.RATeiN, ♦«,♦#«, IS, TSR.i.NJD,  ID,  ITYPE, 

SMOOTH 

00087 

1  LRS.FEKLCC.M.N.PARM.IRR) 

SMOOTH 

00088 

IF(IRR.NE.O)  GO  TO  6010 

SMOOTH 

00089 

c 

SMOOTH 

00090 

CALL  RDINIT 

SMOOTH 

00091 

I TYPE  «  SHKl  XED 

SMOOTH 

00092 

MX, WRY  *6HTER.0C 

SMOOTH 

00093 

CALL  REACMX(IC€CSC,MWCAD,RAKiIN,»rs,^MS,LS,NNi,t,NIDvlD,ITYPE, 

SMOOTH 

00094 

1  LRS.TEXLOC.M.N,  FARM,  IRR) 

SMOOTH 

00095 

IF  (IRR  .♦C.O)  GO  TO  6010 

SMOOTH 

00096 

B175 


c 

SMOOTH 

0009? 

c 

recrcer  me  fexloc  and  texloc  arrays  so  that  there  are 

SMOOTH 

00098 

c 

VALUES  PCR  UNSUBCI  VICED  CHOICS  CU.Y . 

SMOOTH 

00099 

c 

SMOOTH 

00100 

iFocuecv.ea.i)  go  to  120 

SMOOTH 

00101 

«L!CE  =  NSU6CV  -  IXBW 

SMOOTH 

00102 

JCCL  =  NSU6CN 

SMOOTH 

00103 

NDCLS  =  HYBW  ♦  KYBT 

SMOOTH 

00104 

do  no  i=i,Ncas 

SMOOTH 

00105 

TEXLCC(I)  =  (TEYLOC(JCa)  ♦  XSLICEI/XSUBDV 

SMOOTH 

00106 

fe'o.ocu)  =  (fexlocijccl)  ♦  xslicei/xsubdv 

SMOOTH 

0010? 

JCCL  =  JCO.  ♦  N6UBCV 

SMOOTH 

0G108 

110  CONTINUE 

SMOOTH 

00109 

120  CONTINUE 

SMOOTH 

00110 

c 

SMOOTH 

00111 

c 

SMOOTH 

00112 

c 

LOCP  CN  NUNCER  CF  MCCES  (ALSO  NO.  CF  V.P.) 

SMOOTH 

00113 

REWINC  IVPSC 

SMOOTH 

00114 

DO  2000  N*el  ,N*FXES 

SMOOTH 

00115 

c 

SMOOTH 

00116 

c 

READ  CEL  (HI  ARRAY  FRO  IVPSC.  THE  TVP  ARRAY  MUST  BE  SKIPPED 

SMOOTH 

0011? 

c 

IP  IX  IS  NOT  1 

SMOOTH 

00118 

c 

SMOOTH 

00119 

CALL  RCINIT 

SMOOTH 

0G12O 

c 

SMOOTH 

00121 

c 

SMOOTH 

00122 

I  TYPE  =  SHMIXEL 

SMOOTH 

00123 

CALL  REACNX(IVPSC,N0«EAC,RANCIN.NFS.M«,LS,M«,2,NIC,IC,ITYFE, 

SMOOTH 

00124 

1  LRS.CELFHI.M.N.PARM.IRR) 

SMOOTH 

00125 

IP(IRR.NC.O)  GO  TO  6T*4Q 

SMOOTH 

00126 

c 

SMOOTH 

0012? 

CALL  RCINIT 

SMOOTH 

00128 

I TYPE  -  5HHIXED 

SMOOTH 

00129 

call  reacnx(ivpsc,hxread,rancin,nfs,n*6,ls.nm;,2,nic,id,itype, 

SMOOTH 

00130 

1  LRS.TVP.H.N.PARM.IRR) 

SMOOTH 

0G131 

IP(IRR.NC.O)  GO  TO  QC40 

SMOOTH 

0U132 

c 

SMOOTH 

00133 

c 

LOCP  CN  N6URP  TO  RT  EACH  FLANFCRM  INDEPENDENTLY. 

SMOOTH 

00134 

c 

SMOOTH 

00135 

DO  1000  NS=1.NSURP 

SMOOTH 

00136 

c 

SMOOTH 

0013? 

c 

MOVE  CELPHI  FCR  PLANFCRM  NS  TO  AVF  ARRAY  DELETING  ZERO 

SMOOTH 

00138 

c 

VALUES  ANC  CETAIN1M1  THE  (X,Y)  COCRDINATES  IN  (I,J)  INC  ICES 

SMOOTH 

CC139 

c 

SMOOTH 

00140 

IP(N5.EB.2)  GO  TO  100 

SMOOTH 

00141 

c 

SMOOTH 

00142 

c 

FIRST  PLAWCRM 

SMOOTH 

00143 

IBEG  =  1 

SMOOTH 

00144 

ILIM  =  MXBW 

SMOOTH 

00145 

^*4 

f\ 

It 

a 

SMOOTH 

00146 

*CH  =  0 

SMOOTH 

0014? 

CO  TO  200 

SMOOTH 

00148 

c 

SMOOTH 

00149 

c 

SECOC  PLANFCRM 

SMOOTH 

00150 

100  CONTINUE 

SMOOTH 

00151 

IFBT  =  <1  XBT-!  X3W1/NSUBCV  ♦  1 

SMOOTH 

3015? 

IBEG  =  IFBT 

SMOOTH 

00 1  53 
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ILIM  =  MX8T 
IC  =0 
NCH  =  M»BW 
IUf  =  MXBW 

IF(CCPUN)  IUP  =  JFBT  -  1 
DO  125  m.IUP 
IC  =  IC  ♦  JCC(I) 

123  CONTINUE 
200  CONTINUE 
ICS  =  IC 
INO  =  0 

DO  400  IteIBEC.Il.lM 
I  =  IX 

IF(N3.ER.2)  I  =  IX  ♦  KXAP 
JST  =  JS(I) 

JO®  -•  JS(I)  ♦  JQC <1 )-  1 
DO  400  J=JST,JOC 
IC  s  IC  ♦  t 
IB  =  IS(J*NCH) 

IT  =  IB  ♦  HQC(J+5»0()  -1 
IFdX.LT. IB)  CO  TO  400 
lFdX.CT.IT)  CO  TO  400 
INO  =  INO  ♦  1 
AVPsdNO*  =  DELPHI  (IC) 

XU  HOi  =  I 

Y  (INO)  =  J 
4U0  CONTINUE 

C 

C  ADD  THE  LEACINC  EECE  VELOCITY  POTENTIAL  TO  THE  A  VP  ARRAY 

C  VEL.  POT.  =  0.  UNLESS  IT  IS  ECU  SECOND  RAhTCRM  IN  COFLANAR 

C  ANALYSIS 

C 

JLAST  =  MTBVI 
IF(NS.EB.2>  JLAST  =  WBT 
DO  600  J=1 .  JUST 
IB  =  ISCJ+NCH) 

INCe  INO  +1 
X(IN0»  =  FEXLOC(J) 

Y  (I  MCA  a  | 

A  VPS  (INO)  -  (D.,0.) 

iF(NR.Ca.l)  CO  TO  600 

IF  (.NOT.  COPUN)  CO  TO  600 

W*W  -  <FE>LOC(J»HrBW)-TDQ.OC(J) !  *  KI 

JT  =  J 

!F(N»UBBV.»C.t)  JT  =  NSUBDV  *  CJ-t  >  ♦  NSU8CN 
A  VPS  (INO)  =  TVP(JT)  *  CMfLX<CaS(XDKVU,-SIN(XDKVL)> 

«0  CONTINUE 
C 

C  CALL  LEAST  SQUARES  SURFACE  FITTING  ROUTT  IC 

c 

IOIM  3  2 
CM  s  1.0 
I  DEC  s  WCt 

IFOCEC.NE.O)  60  TO  B73 
DO  «S0  IH. 10 
I DEC  =  10  -!♦! 

XM  r  I  DEC  ♦  1 


SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SKOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 

SMOOTH 


b  m 


00154 
00155 
00156 
00157 
00156 
00159 
00160 
00151 
00).  52 
00163 
00164 
00l65 
00166 
00167 
00166 
00169 
00170 

021  a 

00172 

00173 

00174 

0017J 

00176 
00177 
001  >8 
00179 
00180 
00181 
00182 
00183 
00184 
00185 
00186 
00187 
00188 
00189 
00)90 
00191 
00192 
00193 
00194 
00195 
00196 
00197 
00198 
00199 
00200 
00201 
00202 
00203 
00204 
00205 
00206 
00207 
U0208 
00209 
00210 


kh;  =  bvz.o 

SMOOTH 

00211 

K  =  XM  *  xvc  ♦  »€  *  1  .QE-04 

SMOOTH 

00212 

h:  -  ra*NC)  /  z 

SMOOTH 

00213 

IF(NC.LE.INO)  CO  TO  575 

SMOOTH 

00214 

650  CONTINUE 

SMOOTH 

00215 

675  CONTINUE 

SMOOTH 

00216 

ota  fitter <icec.,iw3,x,y,avps,a,cn,  ibim> 

SMOOTH 

00217 

SMOOTH 

00218 

EVALUATE  THE  POLYNOMIAL  EQUATION  FCR 

DELMI 

SMOOTH 

00219 

SMOOTH 

00220 

K5EC  =  I  CEO  ♦  1 

SMOOTH 

00221 

IC  =  ICS 

SMOOTH 

00222 

B0  90C  IXSIBEO.IUM 

SMOOTH 

00223 

I  =  IX 

SMOOTH 

00224 

IFCNS.Ea.2)  1=  IX  ♦IOVLAP 

SMOOTH 

00225 

XP<1>  =  t. 

SMOOTH 

00226 

DO  TOO  IP=2,MDE& 

SMOOTH 

00227 

TOO  XPcIP)  =  XP(IP-1)  4  FLOAT  (I) 

SMOOTH 

00228 

JI  =  JStI) 

SMOOTH 

00229 

JT  =  JOC(I)  ♦  JI  -  1 

SMOOTH 

00230 

DO  900  J=JI,JT 

SMOOTH 

00231 

IC  =  IC  *  1 

SMOOTH 

00232 

IB  =  ISU+NCH) 

SMOOTH 

00233 

IT  =  IB  «■  NOC(J+NCH)  -  1 

SMOOTH 

00234 

IFdX.LT. IB)  CO  TO  900 

SMOOTH 

00235 

IF(IX.CT.IT)  CO  TO  900 

SMOOTH 

00236 

YP<1>  =1.0 

SMOOTH 

00237 

DO  900  JP=2,MEEG 

SMOOTH 

00238 

800  YP(JP)  =  YP(  JP-1 )  *  FLOAT  (J) 

SMOOTH 

00239 

VP  =  A  <1 ) 

SMOOTH 

00240 

IA  =  1 

SMOOTH 

00241 

DO  850  L2=2,MEEG 

SMOOTH 

00242 

DO  850  L3=1.L2 

SMOOTH 

00243 

L4  =  L2  -  L3  ♦  l 

SMOOTH 

00244 

IA  =  IA  >  I 

SMOOTH 

00245 

VP  =  VP  ♦  XP(L4)*YP<L3)*A(IA) 

SMOOTH 

00246 

850  CONTINUE 

SMOOTH 

00247 

DELPHI  <IC)  =  VP 

SMOOTH 

00248 

900  CONTINUE 

SMOOTH 

00249 

SMOOTH 

00250 

CALCULATE  THE  THAI II NO  EECE  ‘VELOCITY 

POTENTIALS  (TVP  ARRAY) 

SMOOTH 

0025’ 

SMOOTH 

00252 

IF(N6.Efl.2)  CO  TO  910 

SMOOTH 

00253 

NTST  =  1 

SMOOTH 

00254 

NT  VPS  =  MYBSW 

SMOOTH 

00255 

C- 

1— 

II 

a 

SMOOTH 

00256 

CO  TO  920 

SMOOTH 

00257 

910  CONTINUE 

SMOOTH 

00258 

NTST  =  NT  VPS  ♦  1 

SMOOTH 

00259 

NT  VPS  '!  NYBSW  ♦  MYBST 

SMOOTH 

00260 

920  CCNTINLC 

SMOOTH 

C0261 

DO  9 JO  J- NTST i NTVPS 

SMOOTH 

00262 

930  TVP(J)  =  <0.,0.) 

SMOOTH 

00263 

SMOOTH 

00264 

MSEC  :  NTST  ♦  NSUBD2 

SMOOTH 

00265 

t€HO  -  NTVPS  -NSUCC2 

SMOOTH 

00266 

JO  -  0 

SMOOTH 

00261 

8178 


U  <J  w  u 


DO  960  4=»«EC,Nr.NC,NSUBDV 

C  4  *  LOCATION  IN  THE  TV*  ARRAY  (SUBDIVIDED  VALUES) 

C  44  *  LOCATION  IN  ARRAYS  TEXLOC,  NX,  IS,  ETC. 

C  JC  =  ^SUBDIVIDED  CHORD  NUMBER 

C  IRON  =  ROW  NUACER  C f  LAST  BOX  ON  THE  CHORD 

C  I  =  ROW  LOCATION  OF  IRCM  IN  ARRAY  IPNTRH 

44  =  44  ♦  1 
40  =  4C  ♦  1 
1  =  TEW.XU4J 

IRON  =  I 

XI NCR  =  TEXLX(JJ)  -  I 

IF  (.NOT.  COR. AN  .AT®.  4  .CT.  KYBW)  I  =  I  ♦  ICVLAP 
1NBB  =  IPNTRNd,!)  ♦  4C  -  1PNTRM(2,I> 

C 

C  TEST  FOR  3  BONES  ON  CHORD  JJ 

IF(NX(JJ>.LT.3)  GO  TO  940 
C 

C  2  DOMES  AN)  NO  MACH  RAY  AVAILABLE,  OR 

C  3  BOXES  OR  MORE.  DO  L1TCAR  EXTRAPOLATION. 

933  CONTINUE 

ITCE  =  IPNTRNd  , I-t '  ♦  4C  -  IPNTRM12,!-!) 

SDELFH  =  DCLfHI(IMDB)  -  DELPHI  (ITCE) 

CO  TO  990 
C 

C  TEST  FCR  WkCH  RAY  EXTRAPOLATION. 

940  CONTINUE 

IB  =  IS(JJ-l) 

IX  =  IB  ♦  NX  (44-1)  ♦  1 

IF  (IRON  .LT.  IB  .05.  IRON  .07.  IX)  GO  TO  945 
IB  a  ISCJ4-2) 

IX  s  IB  ♦  NX (44-2)  ♦  1 
INI  =  IROr-i 

IF  «m  .CC.  IB  .AH).  I  Ml  .LE.  IX)  GO  TO  948 

MACH  RAY  CAHOT  BE  USED.  TEST  FCR  2  BOXES  ON  CHORD  JJ 

945  CONTI  *AJE 

IF  (NX(JJ)  .LT.  2)  CO  TO  ?D10 
CO  TO  935 

MACH  RAY  CAN  BE  USED 

946  CONTINUE 

INCA  =  IPNTRNd, 1-1)  ♦  JC  -  IPNTRM(2,I-I)  -  2 
IWO  s  IPNTRNd, I)  y  JC  -  IPNTRH(2,I)  -1 
SDELPH  s  2.0  *  DELPHI  (IKO  -  CELMd(INCA)  -  DELPHI  (IH)B) 
950  CONTI  MX 
JY  a  JJ 

IFCNSUBDV.tC.l)  JT  S  N5UBCN  ♦  NSUBDV  *  (44-1) 

TVP(JT)  a  DEL  Mil  (ItCB)  ♦  XI NCR  *  SCELTN 
€60  CONTINUE 
C 

iOOO  CONTINUE 

c 

c  WITt  THE  DELPHI  TVP  ARRAY  ON  THE  NIVPSC  FILE 

CALL  RDIWT 
I  TYPE  a  5HNJXCD 
Na  IPNTRNd  .NPNTRS)  -  1 
KXAKRY  =  5HCELPHI 


SMOOTH  00266 
BOSS  HA  00001 
BOSS  HA  C0C02 
BCSSMA  00003 
BCSSMA  00004 
BCSSMA  00003 
SMOOTH  00269 
SMOOTH  00?  TO 
SMOOTH  00271 
BCSSMA  00006 
SMOOTH  00273 
SMOOTH  00274 
BCSSMA  00007 
SMOOTH  002 7 S 
SMOOTH  00276 
SMOUTh  00277 
SMOOTH  00278 
BCSSMA  00CO8 
SMOOTH  00279 
BCSSMA  00009 
SMOOTH  00280 
SMOOTH  00281 
SMOOTH  00282 
SMOOTH  00283 
SMOOTH  00284 
SMOOTH  00285 
SMOOTH  00286 
SMOOTH  00287 
BCSSMA  00010 
SMOOTH  00289 
SMOOTH  00290 
BCSSMA  00011 
BCSSMA  00012 
BCSSMA  00013 
BCSSMA  00014 
BCSSMA  00015 
BCSSMA  00016 
BCSSMA  00017 
SMOOTH  00293 
SMOOTH  00294 
BCSSMA  00018 
SMOOTH  00295 
SMOOTH  00296 
SMOOTH  00297 
SMOOTH  00298 
SMOOTH  00299 
SMOOTH  00300 
SMOOTH  00301 
jr-XXfTH  00302 
SMOOTH  00303 
SMOOTH  0CJ04 
SMOOTH  00305 
SMOOTH  00306 
SMOOTH  00307 
SMOOTH  00308 
SMOOTH  03309 
SMOOTH  00310 


BI79 


CAU.  WRTEMX<NlVPSC.MXWRlT,RANCOU,NFS,f#4S,LS,T*4<.LM&,2,lD, 

SMOOTH 

00311 

1  CEL  HI  l  .  ITYPE.2  .N.  PARM,  IRR) 

SMOOTH 

00312 

IFURR.WC.O)  CO  TO  €040 

SMOOTH 

00313 

C 

SMOOTH 

00314 

N  -  NT VPS 

SMOOTH 

00315 

MXARRY  =  6HTVP 

SMOOTH 

00316 

CALL  VRTEMXtNIYPSC.MXVRIT.RATCOU.NFS.ms.LS.IRR.LVft.a.tB, 

SMOOTH 

00317 

1  TVP,  I  TYPE.  2.  N,  PARM.  IRR) 

SMOOTH 

00318 

IF(IRR.)C.O)  CO  TO  €040 

SMOOTH 

00319 

C 

SMOOTH 

00320 

c 

SMOOTH 

00321 

C  PRINT  THE  SMOOTHED  VEL.  POT.  ARRAY 

SMOOTH 

00322 

IFT.NdT.PRVP)  CO  TO  1500 

SMOOTH 

00323 

TITLtl)  -  8K  WINC 

SMOOTH 

00324 

TITLC)  =10H VELOCITY  P 

SMOOTH 

00325 

TTTL  (3)  =10HOTENTIALS 

SMOOTH 

00326 

IF  (COHAN)  TITL(l)  =  10HWINC/TAIL 

SMOOTH 

00327 

CAJL  PRINTR(TITL,  T*4.  CELFHI,  1,  1,  MXB,  NYBW,  IFNTRM) 

SMOOTH 

00328 

IF(NSISF.EB.1.CR. COFLAN)  CO  TO  1500 

SMOOTH 

00329 

TITL<1>  =  8H  TAIL 

SMOOTH 

00330 

CALL  HIWRCTITL.  CELWI,  1,  IFBT,  M)®T,  KTBT, 

SMOOTH 

00331 

1  IPNTRM(l,IOV_AP*l)  ) 

SMOOTH 

00332 

1500  CONTINUE 

SMOOTH 

00333 

IF  {.NX.  CHECKS)  CO  TO  2000 

SMOOTH 

00334 

WRITE  (NT6.9400)  <TVP<I )  ,  1=1  .NTVPS) 

Smooth 

00335 

9403  FCRMATC//  (1X.8E16.8)  ) 

smooth 

00336 

C 

SMOOTH 

00337 

Z30L  CONTINUE 

SMOOTH 

00338 

C 

CMOOTH 

00339 

EM;  RLE  WVPSC 

SMOOTH 

00340 

REWITC  WVPSC 

SMOOTH 

00341 

C  CHANGE  RLE  NAMES 

SMOOTH 

00342 

c 

SMOOTH 

00343 

IAICSC  =  IVPSC 

SMOOTH 

00344 

ivpsc  =  nivpsc 

SMOOTH 

00345 

c 

SMOOTH 

00346 

RETURN 

SMOOTH 

00347 

€010  CONTINUE 

SMOOTH 

00348 

WRITE  <NT6.9010)  I CC06C .  IRR 

SMOOTH 

00349 

WRITE  (NT6.901 1 )  MXARRY 

SMOOTH 

00350 

CO  TO  €100 

SMOOTH 

00351 

«20  CONTINUE 

SMOOTH 

00352 

WRITE  (NT6.9010)  MCCESCi  IRR 

SMOOTH 

00353 

WRITE  (NT6,90n)  MXARRY 

SMOOTH 

00354 

CO  TO  €100 

SMOOTH 

00355 

€040  CONTINUE 

SMOOTH 

00356 

WRITE  (NT6.9010)  IVPSC. IRR 

SMOOTH 

00357 

WRITE  <NT€,9041)  WN 

SMOOTH 

00358 

H00  CONTINUE 

SMOOTH 

00359 

WRITE  (NTC.9101 )  IC(1)  >IC(2) 

SMOOTH 

00360 

WRITE  (NT6.9102)  PARM,  I  FARM 

SMOOTH 

00361 

WRITE  (NT6.9103)  NFS.NC 

SMOOTH 

00362 

WRITE  (NT€,9104)  1TYPE.M.N 

SMOOTH 

00363 

WRITE  <NT€,9900) 

SMOOTH 

00364 

CO  TO  8000 

SMOOTH 

00365 

C 

SMOOTH 

GO  3  6  6 

*010  CCNTINUE 

SMOOTH 

0'j)<  / 
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MTITE  006,9020)  SMOOTH 

MUTE  (MTS, C02J )  IRCW.JC  BCSSMA 

C  SMOOTH 

9000  CONTINUE  SMOOTH 

CALL  FLUSH  (1)  SMOOTH 

C  SMOOTH 

9020  FCRMAT  (73HC***  ERROR  -  NO  TIP  TRAILING  EDGE  VELOCITY  POTENTIAL  CAN  SMOOTH 
1  BE  COsfVTED.  ***  )  SMOOTH 

cat  FQiMAT (5X,  1 3HCQCRCI NATES  (I2,1H,12,1H>  >  SMOOTH 

9010  FCRMAT <53iC«**  ERfiCR  -  W«LE  READING  THE  GEOCTRY  SCRATCH  FILE  AID  SMOOTH 

1.  1SH,  ERROR  CQCE  =  IA.4H  ***  )  SMOOTH 

9011  FCRMAT (SX, 32HAN  ATTEMPT  HAS  MACE  TO  READ  THE  AS,  0H  MATRIX.//)  SMOOTH 

9041  FCRMAT (SX.54HAN  ATTEMPT  MAS  MADE  TO  READ  THE  VEL.  POT.  ARRAY  NJHJE  SMOOTH 

1R  I3,1H.  )  SMOOTH 

9090  FORMAT  (56HO***  ERROR  -  MULE  MUTING  Ot(  THE  VEL.  POT.  SCRATCH  FILE  SMOOTH 
1  AtO,  19K,  ERROR  CCCE  =  14, AH  ***  )  SMOOTH 

9031  FCRMAT <5X, 3Sif TTEMPTING  TO  MUTE  VEL.  POT.  M>6ER  13  )  SMOOTH 

9101  FORMAT  (SX,  4MATR I X  ID  =  4,  A10,  110)  SMOOTH 

9102  FORMAT (5X, *PAR AMETTERS  *,10E11.3,  /  10X,*(INTEGER)*,  I?,  9Ill  )  SMOOTH 

9103  FORMAT (5*,*FILE  SPACING  =  *,I3,4  MATRIX  SPACING  =  *,  13  )  SMOOTH 

9104  FORMAT (SX.4MATRIX  TYPE  a*,A10.*,  DIMENSIONED  <*I4,2H  X.I4.1H)  )  SMOOTH 

9900  FCRMAT  CO  ERROR  OCCURRED  IN  SMOOTHING  SECTION.  *)  FTNX1 

EM)  SMOOTH 


00366 

00019 

00370 

00371 

00372 

00373 

00374 

00375 

00376 

00377 

00378 

00379 

00380 

00381 

00382 

00383 

00384 

00385 

00386 

00387 

00388 

00068 

00390 


c 

c 

c 

c 

c 


c 

c 


c 


sues  OUT  I  »C  PR  I  NTSC  TITL,IMCCE,ARRAY,K,IXB,M)®,MYB,IPNTRM)  FRNTVP 

PRNTVP 

Tin.  -  TITLE  TO  FRINT  PCS  THE  ARRAY  PR  NT  VP 

IMOOE  -  NODE  SHAPE  NUACES  PRNTVP 

ARRAY  -  ARRAY  TO  8E  FRINT  ED  FRNTVP 

PRNTVP 

DIMENSION  ARRAY  OC.l),  TITL  (3)  PRNTVP 

CCMfVEX  ARRAY  PRNTVP 

D!  MET*  I  CM  I PNTRM(2*100)  PRNTVP 

COHCN  /CCNTRL/  FREVEX.CHACH,  TITLE <8)  ,  PRVCECM,  FRVMCCE.DIHW.DIHT,  CONTRL 
1  DEFAULT  CONTRL 

LOCI  CAL  FRVCECM,  FR  VWCCE,DIHW,  DIHT  i  DEFAULT  CONTRL 

COfrlCN  /FRCBLH-'  XMACH,  NCCES ,  NTSLOP ,  MCVALS, SMOOTH, NDEO.CRDFIT,  RRC8LM 

1  EXAICiSUBDY,  FLYWXC  PRC8LM 

LOCI  CAL  SMOOTH,  CRDF1T,  EXA I  C.SU3DV,  FLYWXC  PRC8LM 

COPOC  /FILES  /  NT5,  NT6,  INTAFE,  IFfSP,  NPLAIC,  NSPAICiNOUTP,  FILES 

1  lOJFSP.MCCESCiIVPSCiICEQSC,  IWTFSC,  IAICSC  FILES 

COMMON  /KVAL  /  IKVAL,»CVAL(20)  ,  »CS(20)  KVAL 

DIMENSION  PC  (2)  PRNTVP 

DIMENSION  f  (50), D(50)  PRNTVP 

BJUI VALENCE  <S (J ), BUFF (1 )),  (D't>, BUFF C125D)  FRNTVP 

REAL  K1  FRNTVP 

INTECCR  PACE  PRNTVP 

COPCN  /RVeuFF/  BFCCCE,  IBFCNT ,  BUFF (3280)  RVDUFF 

DATA  PC  /  1GHFACE  CONTI, 4HNUED  /  FTNX1 

DATA  BLANC  /  1H  /  FTNX1 

DATA  XINIT  /  -1.0  /  FTNX1 

M  =  WCVAL(IKVAL)  FRNTVP 

IF  (NCS(IKVAL)  .NE.  XINIT)  K1  =  #CS(IKVAL>  FRNTVP 

PRNTVP 

FRNTVP 

RACE  =  0  FRNTVP 

N  =1  PRNTVP 

M  =4  FRNTVP 

IF(M.CT.WB)  M  =  MYB  TRNTVP 

100  LIFC  =  100  FRNTVP 

200  DO  1400  I  =  IXB.MXB  FRNTVF 

DO  300  J=N,M  FRNTVP 

S(J)  =  0.0  FRNTVP 

DO)  =  0.0  FRNTVP 

300  CONTINUE  PRNTVP 

IFCLINE.LE. 50)  CO  TO  900  FRNTVP 

RACE  =  PACE  ♦  1  FRNTVP 

UNE  =  4  PRNTVP 

WITE  (NT6.9001)  TITLE, TITL,  XMACH,  Kl ,  IMCCE  FRNTVP 

FRNTVP 

TF(PAC€.E«.l)  CO  TO  TOO  FRNTVP 

MU  TE  (NT6, 9005)  PC  FRNTVP 

CO  TO  800  PRNTVP 

TOO  MUTE(N»6,9005)  FRNTVP 

800  CONTINUE  PRNTVP 

WTTE(NT6,6006)  (BLANC,  J ,  J=N,  M)  FRNTVP 

Wd  £  (NTS,  SOOT)  (BUNC,  4=N,M)  FRNTVP 

900  CONTINUE  PRNTVP 

JS  s  | F*NTRM(2 , 1 )  FRNTVP 

ICX  s  IPNTRM(l.I)  PRNTVP 

JC  rIPNTRMd  ,1*1)  -  ICX  ♦  JS  -1  FRNTVP 


00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00002 
00003 
00004 
00002 
00003 
00004 
00002 
00003 
00002 
00016 
00020 
00021 
00022 
00023 
00002 
000 TO 
00071 
00072 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
00037 
00038 
00039 
00040 
00041 
00042 
00043 
00044 
00045 
00046 
0004  T 

00048 

00049 

00050 

00051 

OOG52 

00053 
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irtjt.ta.O)  co  to  1400 

DO  1000  J-JS.JS 

S(J)  *  REAL  (AkR  AY  (1 . 1 CX)  ) 

DO)  =  AIMAC(ARRAY(1,IDX>  ) 

IDX  a  1DX  ♦! 

1000  CONTINUE 

DO  1200  J=N,H 
IF(S(4>>  1300,1103,1300 
1100  CONTINUE 

IF(DU))  1300,1200,1300 
1200  CONTINUE 
00  TO  1400 

1300  WtITE  (NT6.9013)  I ,  (SCJJ  ,D(J)  ,J=N,Ht 
U*  =  LINE  ♦  1 
1400  CONTINUE 
M  =  M»4 
N  -  N»4 

IF(N.CT.MTB  )  GO  TO  1500 
1F(M.CT.MYB  )  K=NfB 
IFO.INE.CT.45)  CO  TO  100 
PRJTE  (NTS,  6006)  (BLANC ,  J ,  J=N,  H) 

VOITE  (NTS,  BOOT)  (BLANC,  J=N,H) 

LItC  =  LI  ICO 
GO  TO  200 
1500  CONTINUE 
RETURN 

9001  FCRMATdHl.20X.8A10/  46X.4SM00IHED  *,3AI0/  46X,7H(  MACH  F5.3.5X, 
1  12H<ED.  FREB.  s.FB.5,  *  >*  /  52X.4NCCE  SHAPE*,  13) 

9005  FCRMAT(44X,42(lH-)  ,20X,A10,A4) 

S006  FORMAT (4HQRCW,  A1 ,1«X,  5HCHCRC.  13,  3(A1,22X,5HCHCRD,I3)  ) 

BOOT  FORMAT (3X,  4U1,9X.4HREAL,8X.9HIMAGINARY)  > 

9013  FORMAT (14, 8E16.8) 

OC 


PR  NT  VP  00054 
PRNTVP  00055 
FRNTVP  00056 
PR  NT  VP  0005? 
PRNTVP  00058 
PR  NT  VP  00059 
PRNTVP  00060 
PR  NT  VP  00061 
PRNTVP  00062 
PRNTVP  00063 
PRNTVP  00064 
PRNTVP  00065 
PRNTVP  00066 
PRNTVP  00067 
PRNTVP  00066 
PRNTVP  00069 
PRNTVP  00070 
PRNTVP  000?1 
PRNTVP  000?2 
PRNTVP  00073 
VRNTVP  00074 
PRNTVP  00075 
PRNTVP  00076 
PRNTVP  00077 
PRNTVP  00078 
PRNTVP  00079 
PRNTVP  00080 
FRNTVP  00081 
PRNTVP  00082 
PRNTVP  00083 
PRNTVP  00084 
PRNTVP  00085 
PRNTVP  00086 
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*»®Rarn*£  fitter<k.n,x,y,z,c,:n,idim>  fitter 

DIMEA6I0N  X(lOO),  YUOO),  ZCIDIX.IOO).  CUDIH,66>  fitter 

CIHEfelCN  AI<»),A(66,6a),XPm)(YPm)  FITTER 

DIMENSION  VS(IO)  fitter 

LOGICAL  CCMPLX  FITTER 

C  FITTER 

C  M  -  DECREE  CF  POLYNOMIAL  EQUATION  FITTER 

N  -  NUACER  OF  CAT*  POINTS  TO  FIT  CURVE;  THROUGH  FITTER 

C  X  -  X  COCRDINATE  CF  DATA  POINT  FITTER 

C  T  -  T  COCRDINATE  CF  DATA  POINT  FITTER 

C  Z  -  .7  COCRDINATE  CF  DATA  POINT  FITTER 

C  C  -  CUTfVT  COEFFICIENT  ARRAY  FITTER 

C  CN  -  SCALE  FACTOR  FITTER 

C  CN  -  SCALE  FACTOR  FITTER 

C  IDIM  -  INDICATOR  CF  REAL  <R  COfPLEX  FUNCTION  FITTER 

C  =1.  FUNCTION  IS  REAL  fitter 

C  =2,  FUNCTION  IS  COMPLEX  FITTER 

C  IF  COMPLEX  SET  DIMENSION  CF  FUNCTION  AND  COEFFICIENTS  FITTER 

C  TO  MDIM  *  —  )  FITTER 

C  FITTER 

C  DtTERKIAC  NUACER  CF  CCEFFIENT3  FITTER 

C  FITTER 

EPS  =  1.0E-O4  FITTER 

CCMPLX  =  .FALSE.  fitter 

IFCICIM.EB.2)  CCMPLX  =  .TRUE.  'TITER 

C  FITTER 

C  SCALE  DATA  TO  REDUCE  MAGNITUDE  OF  MATRIX  TERP6.  FITTER 

C  SHOULD  IVCHD  BOC  CUTS  DUE  TO  OVERFLOW  CONDITIONS.  FITTER 

IF(CN.EQ.O)  CN=1.U  FITTTR 

IF(CN.EB.l.O)  GO  TO  15  FITTER 

DO  5  1=1  ,N  FITTER 

X<I)  r  XCD/CN  FITTER 

Y(I)  =  Y(I)/CN  FITTER 

5  CCNTIMJE  FITTER 

15  CCNTIMJE  FITTER 

W  =  M  ♦  1  FITTER 

»C=  FITTER 

NC  =  XM*X>€  ♦  x*e  ♦  EPS  fitter 

IFvNC.LE.N)  CO  TO  25  FITTER 

M  =  M-i  FITER 

GO  TO  15  FITTER 

25  CCNTIMJE  FITTER 

C  fitter 

MAC  =  NC  FITTER 

C  FITTER 

C  DETER  Ml  >C  THE  MAXIMUM  DECREE  THAT  CAN  ?E  COMPUTE  N  FITTER 

C  EACH  DIRECTION  AfC  SET  UP  OR  TER  OF  SOLUTION.  FITTER 

C  FinER 

KLV  =  l  FITTER 

*CX  =  N  FITTER 

VS<1)  =  X<1)  FITTER 

DO  60  1=1, N  FITTER 

DO  \3  J=1,*CV  FITTER 

lF(X<t).CQ.YS(J))  GO  TO  55  FITTER 

30  CONTINUE  FITTER 

ACV  =  >CV  ♦  1  FITTER 

YSOCV)  =  X(I)  FITTER 


00002 

00003 

00C04 

00005 

00006 

00007 

ooooa 

00009 
OQOLO 
00011 
00012 
00C13 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
00037 
00038 
00039 
00040 
00041 
00042 
00043 
00044 
00045 
00046 
03047 
00048 
00049 
00050 
00051 
00052 
00053 
00054 
00055 
00056 
GOO  5  7 
00053 
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IF (NCV-1 .EQ.M)  COTOM 
55  CCNTINUE 
TO  CONTINUE 
HDX  =  K)V  -I 
M  CONTINUE 
C 

>ev  =  t 

KSV  :  M 
V5<1>  =  Vtl) 

DO  80  1=1, N 
DO  70  J=1  ,fCV 
iFfrin.EB.VStJT)  CO  TO  75 
70  CONTINUE 

»CV  =  »CV  ♦  1 
VSOCV)  =  Y(I) 

IFOCV-l.EQ.M)  CO  TO  85 
75  CONTINUE 
80  CONTINUE 

►CY  =  NCV  -  1 
85  CONTINUE 
C 

ITOT  =NC  *1 

iTon  =  nor 

if(complx>  i tot  =  iTor  ♦  i 

c 

C  ZERO  OUT  THE  A  ARRAY 

C 

DO  95  1=1,  NC 

'  ,n  =  o.o 

IF  '.NOT.CCMax)  CO  TO  90 
CO, I)  =  0.0 
90  CONTI  f AC 

DO  95  J=l,ITOr 
95  A'l.J)  =  0.0 

c 

C  DETERMINE  DEVIATION  EQUATION  AND 

C 

AI«>  =1.0 

XPIt)  =1.0 

YF(1)  =1.0 

N4  =  N  ♦  1 

DO  200  K=1 ,  N 

VO  10  U=2.»« 

t  (U  =  XP(L-1)*X(K> 

YP<U  =  YP<L-lW(tO 
10  CONTINUE 
C 

I  *  1 

DO  40  L=2,*4 
DO  20  U.«l  ,L 
IL»  L  -  LL  ♦! 

IF<lL-t.4T.NDY>  40  TO  30 
IFtIL-t.4T.ICX>  GO  TO  20 
I  *  I  ♦  1 

Alt!)  *  XP(IL>«YF<LL> 

20  CONTINUE 
3C  CONTINUE 


FITTER  00059 
FITTER  00060 
FITTER  00061 
FITTER  00062 
FITTER  00063 
FITTER  00064 
FITTER  00065 
FITTER  00066 
FITTER  00067 
FITTER  00068 
FITTER  00069 
FITTER  00070 
FITTER  00071 
FITTER  00072 
FITTER  00073 
FITTER  00074 
FITTER  00075 
FITTER  00076 
fitter  00077 
FITTER  00078 
FITTER  00075 

fitter  oooeo 

FITTER  00081 
FITTER  00082 
FITTER  00083 
FITTER  00084 
FITTER  00085 
FITTER  00086 
FITTER  00087 
FITTER  00088 
FITTER  00089 
FITTER  00090 
FITTER  00091 
FITTER  00092 
FITTER  00093 

SQUARE  THE  EQUATION  FITTER  00094 

FITTER  00095 
FITTER  00096 
FITTER  00097 
FITTER  00098 
FITTER  00099 
FITTER  00100 
FITTER  00101 
FITTER  00102 
FITTER  00103 
FITTER  00104 
FITTER  00105 
FITTER  00106 
FITTER  00107 
FITTER  00108 
FITTER  001  OS- 
FITTER  00110 
FITTER  00111 
FITTER  00112 
FITTER  00113 
FITTER  00114 
FITTER  00115 
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40 


45 


1100 

aoo 


c 

c 

r 


1120 

USD 


1155 


tteo 

1175 

1100 

lcDO 


CONTI NUC 

FITTER 

00116 

AI<m>  =  Zll.K) 

flTTER 

00117 

IF<CCM?\_X>  AI  (1*2)  =  Z<2,K) 

FITTER 

00118 

IFtK.CT.l)  CO  TO  45 

FITTER 

00119 

* 

II 

fitter 

00120 

I  TOT  =  NC  ♦  1 

fitter 

00121 

IT OT1  =  I  TOT 

fitter 

00122 

If(CCNPLX)  I TOT  =  I  TOT  ♦  1 

fitter 

00123 

CONTINUE 

fitter 

00124 

fitter 

00125 

DO  1100  1=1, NC 

FITTER 

00126 

DO  1100  J=!  1 1  TOT 

FITTER 

00127 

ASAV  =  AI  (I )  *AI  (J) 

FITTER 

C0128 

A(I ,  J)=A  (I ,  JI+ASAV 

FITTER 

00129 

CONTINUE 

FITTER 

00130 

CONTINUE 

FITTER 

00131 

FITTER 

00132 

SQUARE  ROOT  METHCt 

FITTER 

00133 

INTER  MEDIATE  MATRIX 

fitter 

00134 

DO  1200  1=1, NC 

fitter 

00135 

INI  =  1-1 

fitter 

00136 

TNP=O.0 

fitter 

00137 

IFd  .E0.1)  CO  TO  1150 

FITTER 

00138 

DO  1120  L  =1,1  Ml 

fitter 

00139 

TMP=  TMP*  A(L,I)**2 

fitter 

00140 

CONTINUE 

FITTER 

00141 

T  =  A  (I ,  I )  -  TMP 

FITTER 

00142 

If (T.CT.EPS)  CO  TO  4 

FITTER 

00143 

A(I, I)  =  0.0 

FITTER 

00144 

CO  TO  1200 

fitter 

00145 

CONTINUE 

FITTER 

00146 

Ad, I)  =  SORT  (T) 

FITTER 

00147 

If  (Ad,  I)  .CT.  EPS)  CO  TO  1155 

FITTER 

00148 

Ad.ITOT)  =  0.0 

FITTER 

00149 

CO  TO  1200 

FITTER 

00150 

CONTINUE 

fitter 

00151 

fitter 

00152 

JS  =  \*l 

fitter 

00153 

DO  1100  J  =  JS.ITOT 

fitter 

00154 

TMP=  0.0 

fitter 

00155 

ifd .ea.i/  co  to  ii75 

fitter 

00156 

to  lieo  s.=i, im 

fitter 

00157 

TMP  =  TMP  ♦  A  (L,  I )  *A  (L,  J) 

fitter 

00158 

A(I,J)  =  (A  d  ,  J)-TMP)/A  (I ,  I ) 

fitter 

00159 

CONTINUE 

fitter 

00160 

CONTINUE 

FITTER 

00161 

FITTER 

00162 

fitter 

0C163 

BACK  SUBSTITUTE  fCR  COEFFICIENTS 

fitter 

00164 

DO  1400  K=1 , NC 

fitter 

00165 

I  =  NC  -  K  ♦  1 

FITTER 

00166 

m=iM 

FITTER 

00167 

TMP1  =  0.0 

FITTER 

00168 

TMP2  =0.0 

FITTER 

00169 

IFUd, D.CT.EPS)  CO  TO  1325 

FITTER 

00170 

Cii.I)  =  0.0 

FITTER 

001  7i 

I f (CCMfl. X)  CI2.I)  r  0.0 

FITTER 

00172 

B 1 86 


CO  TO  1400 
1325  CONTINUE 

IFCI.EO.NOCO  TO  1375 

DO  1330  L=IP1,NC 

TNP1  =  7NP1  ♦  ACI,L)*CC1,L> 

IFC.NOT.CCNPLX)  CO  TO  1350 
TNP2  =  TMP2  4  ACt,D«CC2,L) 

1330  CONTINUE 
1375  CONTINUE 

C(1,I>  =  <ACI,ITQT1)-TNP1)/ACI,1) 

IFt.NOT.CCNPLXJ  CO  TO  1400 
Ctt,I>  =(A(I tlTOT)  -TNP2)/AfI,n 
1400  CONTINUE 
C 

c 

C  REORDER  THE  COEFFICIENTS  IN  CORRECT  FCWERS 

C  CP  X  AND  Y. 

C 

IF(NAC.EQ.NC)  CO  TO  1475 

c 

12  =  1 
I  =  t 

DO  1440  L=2.»« 

DO  1420  LL=1,L 
IL  =  L  -LL  41 
I  =  I  41 

IF(LL-1  .LE.MDY .AEC.  IL-1  .LE.MEX)  CO  TO  1410 
XCI)  =  0.0 
YCI)  =  0.0 
CO  TO  1420 
1410  CONTINUE 

12  s  12  4  1 

XCI)  =  CC1.I2) 

IFCCCNK.X)  YCI)  =  CC2.I2) 

1420  CONTINUE 
1440  CONTINUE 
C 

DO  1490  I=2,NAC 
CCl.I)  s  XCI) 

IFCCCNFLX)  CC2.I)  =  YCI) 

1430  CONTINUE 
1475  CONTINUE 
C 

C  ELIMINATE  THE  SCALE  FACTOR  FRCN  THE  COEFFICIENTS. 

C 

iFCCN.Efl.l  .0)  CO  TO  1700 
1=1 

CF»  1.0/CN 
DO  1600  LI =2 t MM 
DO  1500  L2=1,L1 
I  «  141 

CCl.I)  *  CCl.IXF 
CC2.I)  s  CC2,I)4CF 
1500  CONTINUE 
CP=  CP/CN 
1600  CONTINUE 
1700  CONTINUE 


fitter 

00173 

fitter 

00174 

fitter 

00175 

fitter 

00176 

fitter 

00177 

fitter 

00178 

fitter 

00)79 

fitter 

00180 

fitter 

00181 

fttier 

00182 

FITTER 

00183 

FITTER 

00184 

fitter 

00185 

fitter 

00186 

fitter 

00187 

FITTER 

00188 

FITTER 

00189 

fitter 

00190 

fitter 

00191 

fitter 

00192 

fitter 

00193 

fitter 

00194 

FITTER 

00195 

FITTER 

00196 

FITTER 

00197 

FITTER 

OCT  98 

FITTER 

00199 

fitter 

00200 

fitter 

00201 

fitter 

00202 

fitter 

00203 

fitter 

00204 

FITTER 

00205 

FITTER 

00206 

FITTER 

00207 

fitter 

00208 

fitter 

00209 

fitter 

00210 

FITTER 

00211 

FITTER 

00212 

fitter 

00213 

fitter 

00214 

fitter 

00215 

fitter 

00216 

fitter 

00217 

fitter 

00218 

fitter 

00219 

fitter 

00220 

fitter 

00221 

FITTER 

00222 

FITTER 

00223 

FITTER 

00224 

FITTER 

00225 

FITTER 

00226 

FITTER 

00227 

FITTER 

00228 

FITTER 

00229 
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FITTER 

THE  C  ARRAY  NCM  CONTAIN  THE  COEFFICIENTS.  FITTER 

FITTER 
FITTER 

fitter 


00210 

00231 

00232 

00233 

00234 


RETURN 

EM) 


OVERLAY  L.F>«OX,l  ,7) 

PROGRAM  CHQRDF 

1HIS  PROGRAM  WILL  FIT  A  CURVE  THROUGH  THE  VELOCITY  POTENTIALS 
ALONG  EACH  CHORD  I NDE?E)CENTLY .  THESE  CIRVES  WILL  BE  USED  TO 
EVALUATE  A  SMOOTHED  VELOCITY  POTENTIAL. 

C04TCN  /ARRAYS/  KBXCDW,LBXCDU,LBOXC,KBXCDT,L8XCDT,KJALFH,L4ALPH, 

1  KALfHA  tKKDiN..LXERN.iKPNTRM,LPNTRMiKtEFSLiKELfHI , 

2  lmoces.kpntsd.lpwsd.ksdw.lscw.kpntdw.lpntdw. 

3  KCW.LDW.KTVP.LTVP 

CON4CN  /FILES  /  NT5.NT6, INTAPE, I^SP.NPLAIC.NSPAIC.KJUTP, 

1  IOUFSP,  HCCESC)  I VPSC,  I  &EOSC,  IWTFSC,  IAICSC 

CO*ON  /IOCCNT/  OR_AIC,C6FAIC,WTCECN,WrGWF,WYSL,WrBL,FRBOX, 

1  PRPAIC,PRSAIC,PRMOCS,PRCOEF,PRCW,BRSW,FRVP, 

2  PRBL,PRDCP,PRGNAF,fRGNAC,PRSL,fRLW,fRNW,PRCh 
SBUI VALENCE  (TRUW.PRCW) 

LOGICAL  CKAIC,C6FAIC,WTGECM,  WTGNAF,WTSLiWTBL,  PRBOX,  TRFAiC, 

1  PRSAIC,  PRMCCS,  fRCCEF,  FREW,  PRSW,  PRVP,  RRBL,  PRSL,  FRGNAF, 

2  PRDCP,PRGNAC,TRUW,fRLW,fR)MfRCM 

CO*«N  /PRCBLM/  XMACH,T*CCE5,NTSLCiP,NCVALS, SMOOTH, NCEO.CRCnT, 

1  EXAIC.SLBDV.PLYWOCC 

LOGICAL  SMOOTH  ■  CRDFI T ,  EXAIC ,  SUBDV ,  FL.YWXC 

CCMCN  /KVAL  /  IKVAL,WVAL(20>,  WS<20> 

CO«CN  /GECNTY/  CCFLAN,  NSUGCV,  XSUBDV , N5UBC2 ,  T6UBCN,  NSLRF , 

7  B1  iB1BETA,B15iB1BTAS,V4_AX,W_AZ,  PSIW, 

2  MXBW,  HXBBW,  MYBW,  HTBBW,  MXBSW,  MT  BSW,  Hf  BBSW, 

3  IXBW.XCENTR 
LOGICAL  COFLAN 

COPCN  /&ECK2  /  TLAX.TLAZ,  P5lT,MXBT,MYBT,MfBBT ,  MXBST.HfBST , 
t  MYBBST.IXBT.IXBST.aFL 

COMCN  /TAPE IOC  7fS,NH5,LS,7M<,!C(20)  ,  NID,!TYFE,LRS,LW5,M,N, 

1  PARM(IO) ,  IRR 

DIMENSION  IFARM(IO) 

OUI  VALENCE  (FARM,  IPARM) 

COMCN  /CHECK PR/  CPf<PR,C€OCfR,MCDCfR,AICCfR,NW&CfR,SMCPR,GAFCFR 
LOGICAL  DPPCFR,  CCOCFR,  MCCCPR,  AICCTR,M45CfR,  SMCPR,  GAFCFR 
BBUI VALENCE  (CHECK  FR,  SMC  PR) 

LOGICAL  CHECK** 


DELPHI  OCCKES) ,  TVP(NCCLS1  ♦  NCCLS2  *  NSUBDV) 
COMPLEX  DELPHI  (10D0) ,  TVPC250)  >  AVPS(52) 

XOC.  DELFHI  ♦  TO,  TVP) ,  Y  (SAME) 

DIMENSION  X(32),  Y (52) 

A  (NO.  CCEFF.) 

COMPLEX  A  (21) 

CCMMCN  /INDEX/  IS(IOO)  ,MX(100) ,  JS<lCt)S  ,  JOC(IOO) 

FE)®.OC{(MYBWfMYBT)*N5UBDV)  ,  TEXLOC  (SAME) 
DIMENSION  rE».0C(250),  TE*.0C(2J0> 

t  PNTRM  (2 .  )ROM5*HSUBDV) 

DltCNSION  IPNTRM(2,|SQ) 

ODCNSION  TITL(3> 

REAL  Kt 

COMPLEX  VP,  SOELPH,  VC,  AVPA,  AVP9 
LOGICAL  M)*EAD,MXVRIT,RANDIN,RAMCCU 


CHCRDF 

CHORDF 

CHCRDF 

CHCRCF 

CHCRDF 

CHCRDF 

CHCRDF 

ARRAYS 

ARRAYS 

ARRAYS 

ARRAYS 

FILES 

files 

IOCONT 

IOCCNT 

BCSFRB 

IOCCNT 

IOCCNT 

iOCCNT 

BCSFRB 

PRCBLM 

FRC8LM 

PRCBLM 

KVAL 

CpECHTY 

GECNTY 

gechty 

GECNTY 

GECNTY 

GEOP 

GEOC 

TAFEIO 

TAPEIO 

TAPEIO 

TAPEIO 

CHECK  PR 

CHECK  PR 

CHCRDF 

FTNX1 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

OKRCF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 

CHCRDF 


00002 
00003 
00004 
00005 
OOOCS 
00007 
00008 
00002 
00003 
00004 
00005 
00002 
00003 
00002 
00003 
00001 
00005 
00006 
00007 
00002 
00002 
00003 
00004 
00002 
00002 
00003 
00004 
00005 
00006 
00002 
00003 
00002 
00003 
00004 
00005 
00002 
00003 
00019 
00073 
00020 
00021 
00022 
00023 
00024 
00025 
00026 
00027 
00028 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
GOO  3  7 
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HI  =  *CVAL(lXVAL) 

CHORD  F 

00038 

MH5EAC  =  .FA  LSC. 

CHCRDF 

00039 

«U»CIH  =  .FALSE. 

CHCRDF 

00040 

NXVRIT  =  .FALSE. 

CHCRDF 

00041 

RATCCU  =  .FALSE. 

CHCRDF 

00042 

MX8  =  MX8W 

OKRCF 

00043 

JF(CCF^AN)  HXB  =  MX8T 

CHCRDF 

00044 

c 

CHCRDF 

0CO45 

c 

CRCRDF 

00046 

c 

PUT  NAME  CF  SCRATCH  FILE  FCR  SMOOTHED  VALUES  INTO  PUCE 

CHCRDF 

00047 

c 

CHCRDF 

00048 

WVPSC  =  IA1CSC 

CHCRDF 

00049 

REMIT®  WVPSC 

CHCRDF 

00050 

c 

CHCRDF 

00051 

c 

GET  THE  PUT®  CRM  POINTERS  FRCH  THE  MCCESC  FILE 

CHCRDF 

00052 

c 

CHCRDF 

00053 

REMIT®  MOCEBC 

CHCRDF 

00054 

CALL  RDINIT 

CHCRDF 

00055 

I  TV  PE  =  5HMIXEE 

CHCRDF 

00056 

MXARRY  =  WIPNTRM 

CHCRDF 

00057 

CALL  KEACMX(MOCESC,M«EAC,RANCIN,KFS,NMS,LS,^,2,NIC,ID,ITYFE, 

CHCRDF 

00058 

1  LR$.IPNTRM,2,NFVTRS,FARM,IRfi> 

CHCRDF 

00059 

ICVUP  =  IPARMI3) 

CHCRDF 

00060 

IF(IRR.TC.O)  CO  TO  6020 

CHCRDF 

00061 

c 

CHCRDF 

00062 

CALL  RCINIT 

CHCRDF 

00063 

I  TYPE  =  5HMIXEI 

CHCRDF 

00064 

NFS  =  1 

CHCRDF 

00065 

MXARRY  =6HIS  FT. 

CHCRDF 

00066 

CALL  READMX(MOCESC,M)REACiRAT®IN,T®$,THSiLS,TMt>l,NICi  I Di  I TYPE, 

CHCRDF 

00067 

1  LRS,  IS,  M,  N,  PARH,  IRR) 

CHCRDF 

00068 

IF(IRR.fC.O)  CO  TO  6020 

CHCRDF 

00069 

c 

CHCRDF 

00070 

c 

CHCRDF 

00071 

V. 

READ  THE  FEXLOC  AND  TEXLOC  ARRAYS  FROM  THE  CEOCTRY  SCRATCH 

CHCRDF 

00072 

c 

FILE.  THESE  ARE  TEHEE  TO  INTERPOLATE  VELOCITY  POTENTIALS  AT 

CHCRDF 

00073 

c 

BCK  EDCES. 

CHCRDF 

00074 

c 

CHCRDF 

00075 

REWIND  ICCC6C 

CHCRDF 

00076 

CALL  RCINIT 

CHCRDF 

00077 

T*6  =  2 

CHCRDF 

00078 

IFCNSURF.EO.l  .OR. COPUN)  T«s=l 

CHCRDF 

00079 

I  TYPE  =  3HMIXED 

CHCRDF 

00080 

MXARRY  -  6H  FEXLOC 

CHCRDF 

00081 

CALL  REACMXII CEC6C  ,M)READ,RANCIN,  T®S,  TMS,LS,  T*R  ,1  >NI  C,  IC,  ITYPE, 

CHCRDF 

00082 

I  LRS, FEXLOC, M.N.FARM, IRR) 

CHCRDF 

00083 

IFURR.TC.O)  CO  TO  6010 

CHCRDF 

"0084 

c 

CHCRDF 

00005 

CALL  RDINIT 

CHCRDF 

00086 

ITYPE  =  5HMIXED 

CHCRDF 

00087 

MXARRY  =6H  TEXLOC 

CHCRDF 

00088 

CALL  READMX<,G€C$C,MXREAD,RANDJN,T®S,T*«,LS,T*R,1,NID,  ID,  ITYPE, 

CHCRDF 

00089 

1  LRS, TEXLOC, M,N, FARM,  IRR) 

CHCRDF 

00090 

I"(I.;R.TC.0>  CO  TO  6010 

CHCRDF 

00091 

c 

CHCRDF 

0G092 

c 

REORDER  THE  FEXLOC  AND  TEXLCC  ARRAYS  SO  THAT  THERE  ARE 

CHCRDF 

00(391 

c 

VALUES  FCR  UNSUBCi  VI  DEC  CHORDS  CT4.Y . 

CHCRDF 

GOG  9  • 

B190 


n  n 


c  OKRDF 

lF(N5UBCV.Ea.l>  CO  TO  120  CHCRDF 

XSLIDE  =  MSUBDV  -  IXBW  CHCROF 

JCCL  =  NSUBCN  CHCRDF 

MCCLS  =  MYBW  ♦  HYBT  CHCRDF 

DO  110  l=l,NCCLS  CHCRDF 

TE«.ct<n  =  <teh.oc<jccl>  ♦  xslide) /xsubdv  chcrdf 

FtXLOC(I)  =  <FEXLOC<JCCL)  ♦  *SLIDE)/XSUBDV  CHCRDF 

JCCL  =  JCCL  ♦  N5UBDV  CHORD F 

110  CONTINUE  CHCRDF 

120  CONTINUE  CHOP.DF 

C  CHCRDF 

IFBT  =  «XBT-tX8W>/NSUB0V  ♦  1  CHCRDF 

C  CHCRDF 

C  LOOP  ON  NUtCEK  OF  MCCE5  (ALSO  «J.  OF  V.P.)  CHCRDF 

REWIND  IVPSC  CHCRDF 

DO  2000  Mt*=l  t FMCCES  CHCRDF 

C  CHCRDF 

C  READ  DELPHI  ARRAY  fRCM  IVPSC.  THE  TVP  ARRAY  MUST  BE  SKIPPED  CHCRDF 

C  IF  NM  IS  NOT  I  CHCRDF 

C  CHCRDF 

CALL  R  Cl  NIT  CHCRDF 

I  TYPE  -  S+MIMEE  CHCRDF 

»•«  =  1  CHCRDF 

’F(^N.ea.i)  phs  =  a  chcrcf 

CALL  REACMXdVPSC.MWEAC.RAKCIN.KfS.fWS.LS.^.Z.NID.IC.lTYPE,  CHCRDF 

1  LR5, DELPHI, M,N, FARM. IRR)  CHCRDF 

IF(IRR.AE.O)  CO  TO  6040  CHCRDF 

C  CHCRDF 

LOOP  ON  NUACER  CF  CHORDS  CHCRDF 

CHCRDF 

NCHRCS  =  MYBW  CHCRDF 

IF(NSURF.E0.2)  WORDS  =  MYBW  ♦  MYBT  CHCRDF 

DO  1000  J=l,  NCHRCS  CHCRDF 

*C  =  1  CHCRDF 

IFCJ.CT.MYBW)  NC  =  MYBW  «■  t  CHCRDF 

1ST  s  IStJ)  CHCRDF 

NC  s  1ST  ♦  NOC(J)  -  1  CHCRDF 

JSCJN:  0  CHCRDF 

I  TROW  =  1ST  CHCRDF 

IFC.NCTr.COfEAN.APC.J.CT.MYBLn  I  TROW  =  1ST  ♦  ICVLAP  CHCRDF 

DO  100  1=1,1  TROW  CHCRDF 


100  JSUM  s  JSUM  ♦  JCCCI) 

JSUM  r  JSUM  -  JOC  (ITRCW)  ♦  1 
IND  s  0 

DO  2C0  I=IST,NC 
l*  =  I 

IND  s  ftC  ♦  1 

IFC. NOT, COPLAN. APO.J.CT. MYBW)  IK  *  I  ♦  IOVLAP 

me  a  jsum  ♦  j  -  jsux)  -  nc  ♦  t 


XC1ND)  *  I 

A  VPS  (IND)  r  DELPHI  (ISUB) 

JSUM  s  JSUM  ♦  JOC  (IX) 

BOO  CONTINUE 
C 

C  find  THE  DERIVATIVE  CF  DELPHI 

C 


00095 
00096 
00097 
00098 
00099 
001G0 
00101 
00102 
00103 
00104 
00105 
00106 
00107 
00108 
00109 
00110 
00111 
00112 
00113 
00114 
00115 
00116 
00117 
00118 
00119 
0-0120 
00121 
00122 
00123 
00124 
00125 
00126 
00127 
00128 
00129 
00130 
00131 
00132 
00133 
00134 
00135 
00136 
CHCRCF  00137 
CHCRDF  00138 
CHCRDF  00139 
CHCRDF  00140 
CHCRDF  00141 
CHCRDF  00142 
CHCRCF  00143 
CHCRDF  00144 
CHCRDF  00145 
CHCRDF  00146 
CHCRDF  00147 
CHCRDF  00148 
CHCRDF  00149 
AW  SMOOTH  THESE  CHCRCF  00150 

CHCRDF  00151 


B191 


VC  =  A  VPS  (1 ) 

CHCRDF 

00152 

t*CMl  =  I*C  -1 

CHCRDF 

00153 

AVPA  =  0.5  *  <AVPS<1)  ♦  AVP$  (2) ) 

CHGRDF 

00154 

AVPS(l)  =  (A VPS  (2)  -  AVPS  (1 ) )/  <X(2> 

-  X(l>) 

CHCRDF 

00155 

DO  350  t=2,ITCW 

CHCRDF 

00156 

AVPB  =  0.5  *  (AVPS  (I )  ♦  AVPS(M)) 

CHCRDF 

00157 

AVPS (I)  =  «VPS  -  AVPA 

CHCRDF 

00158 

AVPA  =  AVPB 

CHCRDF 

00159 

350  CONTINUE 

CHCRDF 

001  GO 

AVPSOMD)  =  (AVPsmC)  -  AVPA)/0.5 

CHCRDF 

0016i 

I  HD  =  lfC  ♦  1 

CHCRDF 

00162 

IfCW  =  UCM1  ♦  1 

CHCRDF 

00163 

AVPSUfC)  =  AVPS(lNCMl) 

CHCRDF 

00164 

x(ifc>  =  xcitcmi)  ♦  0.5 

CHCRDF 

OOI65 

c 

CHCRDF 

00166 

XINC  =  X<1> 

CHCRDF 

00167 

DO  375  I=1,ITC 

CHCRDF 

00168 

x<n  =  x(n  -  xinc 

CHCRDF 

00169 

375  CCHTI HUE 

CHCRDF 

00170 

I  DEC  =  fCEG 

CHCRDF 

00171 

C 

CHCRDF 

00172 

C  CALL  FITTING  ROUTiTC  LEAST  SQUARES  ERROR  CURVE 

CHCRDF 

00173 

C 

CHCRDF 

00174 

CALL  CUKVEU  CEG.  IK!,  X,  AVPS,  A) 

CHCRDF 

00175 

C 

CHCRDF 

00176 

C  EVALUATE  THE  CURVE  FCR  SMOOTH  CELWI 

VALUES 

CHCRDF 

00177 

C 

CHCRDF 

00178 

K5EG  =  I  CEO  »  1 

CHCRDF 

00179 

JSUM  =  0 

CHCRDF 

00180 

DO  400  I=1,TTRCW 

CHCRDF 

00181 

400  JSUM  =  JSUM  ♦  JOCU) 

CHCRDF 

00182 

c 

CHCRDF 

00183 

JSUM  =  JSUM  -  JOC(ITRCW)  ♦  1 

CHCRDF 

00184 

DO  500  I  =  IST.NC 

CHCRDF 

00185 

IX  r  I 

CHCRDF 

00186 

IF(.NOT.COFLAN.ANC.J.GT.MTBW)  IX  = 

l  ♦  ICVLAP 

CHCRDF 

00187 

I SUB  =  JSUM  ♦  J  -  JSUX)  -  NC  ♦  1 

CHCRDF 

00188 

VP  r  VC 

CHCRDF 

00189 

XV  =  FLOAT (I)  -  XINC 

CHCRDF 

00190 

XP  =  1.0 

CHCRDF 

00191 

DO  450  L  -  l.MDEG 

CHCRDF 

00192 

XP  =  XP  *  XV 

CHCRDF 

00193 

XD  =  L 

CHCRDF 

00194 

XPI  =  XP/XL 

CHCRDF 

00195 

VP  =  VP  ♦  A(L)  *  XPI 

CHCRDF 

00196 

450  CONTINUE 

CHCRDF 

00197 

DELPHI  (I SCO)  =  VP 

CHCRDF 

00198 

JSUM  =  JSUM  ♦  JOCUX) 

CHCRDF 

00199 

500  CONTINUE 

CHCRDF 

00200 

C 

CHCRDF 

00201 

C  CALCULATE  THE  TRAILING  EDGE  VELOCITY 

POTENTIALS  (TVP  ARRAY) 

CHCRDF 

00202 

C 

CHCRDF 

00203 

L  =  J 

CHCRDF 

00204 

IT'<N5’JeCV.HE.l)  L  =  NSUBDV  *  (J-l) 

♦  NSU8CN 

CHCRDF 

00205 

TVP<U  =  (0.,0.) 

CHCRDF 

00206 

JJ  =  J 

CHCRDF 

0G207 

JC  =  J 

OtCRCF 

00?0« 

819? 


n  n  <■>  ri 


IF(J.CT.MTBW)  JC  =  4  -  WY8W 
I  =  TE*.OCO'J) 

XI NCR  =  TEXLOC(JJ)  -  I 
IRON  x  I 

IFI.NOT.COfLAN.AND.J.OT.MYBU)  1  =  1*  ICVLAP 
IfCB  =  IPNTRMd.l)  ♦  JC-  IPNTRM<2,I) 

C 

C  TEST  FCR  3  BOXES  ON  CHORD  JJ 

IF(NOC (J J) .LT .3)  CO  TO  940 
C 

C  2  BOXES  ANC  NO  MACH  RAY  AVAILABLE,  CR 

C  3  BOXES  CR  MORE,  po  LINEAR  EXTRAPCLATICN. 

geo  ccntinue 

I«E  -  IPNTRHd.I-l)  ♦  JC  -  IPWTRM<2,I-I> 

SDQ.FH  =  DELPHI  (INCB)  -  DELfHI  (IfCE) 

CO  TO  950 
C 

C  TEST  FCR  mCH  RAY  EXTRAPOLATION. 

940  CONTINUE 

IB  -  IS(JJ-l) 

IX  =  IB  ♦  NnC(JJ-l)  «•  1 

IF  (IRON  .LT.  IB  .OR.  IRON  .OT.  IX)  CO  TO  945 
IB  =  ISIJJ-2) 

IX  =  IB  ♦  NOCIJJ-2)  ♦  I 
I  MX  =  IRCW-i 

xF  (IMI  .«£.  IB  .Af«.  I  Ml  .LE.  IXV  GO  TO  948 

MACH  RAY  CAPWOT  BE  USED.  TEST  FCR  2  BOXES  ON  CHORD  JJ 
9*5  CONTINUE 

IF  (NQC(JJ)  .LT.  2)  CO  TO  7010 
CO  TO  900 

MACH  RAY  CAN  BE  USED 
94 «  CONTINUE 

ITCA  =  IPNTRMJl.I-l)  ♦  JC  -  IPNTRM(2,I-1)  -  2 
IfCC  =  IP-TRNd.H  ♦  JC  -  I PNTRMI2, 1 )  -1 
SDELfH  =  «..0<*DELfHI<INCC>  -  CQ.fHHINCA;  -  DELPHI  (I NCB) 

950  CONTINUE 
JT  =  JJ 

IFlNSUBCV.fC.n  jT  «  N5U6DV  *  IJJ-I)  ♦  NSUBCN 
TVP(JT)  =  CELfHI  (ITC8)  ♦  XINCR*SDELfH 
9«  CONTINUE 
C 

1000  CCNTINUE 
C 

C  MITE  JWE  tLLfHI  AfC  TVP  ARRAY  ON  THE  N1VPSC  FILE 

^*LL  RDINIT 
I  TYPE  *  5HM1XED 
N  *  IPNTRMd.NPHTRS)  -  1 
MARRY  x  BHCELfHI 

CALL  rRTEMXINIVPSC.rtXVRIT.RANWJ.NFS.N^.LS.WH.LVe.a.ID, 
I  DafHI,mPE,2,N,PARM,IRR) 

IFdRR.XC.O)  CO  TC  6040 
C 

MTV  PS  x  N5U50V  4  HOODS 
r  MTVPS 
MMRfiY  =  6MTVP 


CHCRDF 

00209 

CHQ7DF 

0321 0 

CHCRDF 

00211 

B  CSC  PA 

<30001 

CHCRDF 

002 *.2 

CHCRDF 

002)3 

CHCRDF 

00214 

CHCRDF 

00215 

CHCRDF 

00216 

CHCRDF 

00217 

BCSCFA 

00002 

CHCRDF 

00218 

BCSCFA 

00003 

CHCRDF 

00219 

CHCRDF 

00220 

CHCRDF 

00221 

CHCRDF 

00222 

CHCRDF 

00223 

CHCRDF 

00224 

CHCRDF 

00225 

CHCRDF 

30226 

BCSCFA 

00004 

CHCRDF 

00228 

CHCRDF 

00229 

BCSCFA 

00005 

bocfa 

00006 

BCSCFA 

00007 

BCSCFA 

00008 

BCSCFa 

00009 

BCSCFA 

0001? 

BCSCFA 

00011 

CHCRDF 

00232 

CHCRDF 

00233 

BCSCFA 

00012 

CHCRDF 

00234 

CHCRDF 

00235 

CHCRDF 

00236 

CHCRDF 

00237 

CHCRDF 

00238 

CHCRDF 

00239 

CHCRDF 

00240 

CHCRDF 

00241 

CHCRDF 

00242 

CHCRDF 

00243 

CHCRDF 

C0244 

CHCRDF 

00245 

CHCRDF 

00246 

CHCRDF 

0024? 

CHCRDF 

00248 

CHCRDF 

00249 

CHCRDF 

00250 

CHCRDF 

00251 

CHCRDF 

00252 

CHCRDF 

00253 

CHCRDF 

00254 

CHCRDF 

00235 

CPKRC*' 

00256 
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call  vrtcmxinivpsc.mxwiit.ranccu.nfs.^.ls.rme.lvjs.z.ic. 

CHCRDF 

0025? 

t  tvp,  itype.Z.n.parm.irr) 

CHCRCF 

00258 

IFURR.tC.OT  CO  TO  6040 

CHCRDF 

00259 

c 

CHCRDF 

00260 

C  PRINT  THE  SMOOTHED  VEL.  r3T.  ARRAY 

CHCRDF 

00261 

C 

CHCRDF 

00262 

IFi.MOT.IRVP)  GO  TO  1500 

CHCRDF 

00263 

TITL  <1 )  =  8H  WING 

CHCRDF 

00264 

TITL<2>  =10H VELOCITY  P 

CHCRDF 

00265 

TITL (3)  =tOHOTENTIALS 

CHCRDF 

00266 

IF (COPlAN)  TITL(l)  =  lOHWI  MV/TAIL 

CHCRDF 

00267 

CALL  PRINTR(TITL,N4,CELFH1  ,1 ,1 ,  MX3 .  KfBW,  I  PNTRMT 

CHCRDF 

00268 

IF (NSLRF.EQ  .1  .Or  .COfL-AN)  GO  TO  1500 

CHCRDF 

00269 

T1TL<1)  =  8H  TAIL 

CHCRDF 

00270 

CALL  PRINTR(TITL,T*I,  DELPHI  ,1 , 1 FBT,  MXBT,  WYBT,  I PNTRMU  ,  ICWLAPtl  > ) 

CHCRCF 

00271 

1500  CONTINUE 

CHCRDF 

00272 

IF(. NOT. CHECKER)  GO  TO  2000 

CHCRDF 

00273 

WUTE(NT6,940G)  <TVF<I) ,  1=1  .NTVPS) 

CHCRDF 

00274 

9400  FORMAT  <// <1  X.8E16.8)) 

CHCRDF 

002?5 

C 

CHCRDF 

00276 

2000  CONTINUE 

CHCRDF 

00277 

C 

CHCRDF 

00278 

ETC  RLE  WVPSC 

CHCRDF 

00279 

REWltC  NI VPSC 

CHCRDF 

00280 

C  CHANGE  FILE  tWMES 

CHCRDF 

00281 

C 

CHCRDF 

00282 

IAICSC  =  IVPSC 

CHCRDF 

00283 

IVPSC  =  NIVPSC 

CHCRDF 

00284 

C 

CHCRCF 

00285 

RETURN 

CHCRCF 

00286 

9310  CONTINUE 

CHCRDF 

00287 

VRITE  (NT6.9010)  IGE06C.IRR 

CHCRDF 

00288 

VRITE  (NT6,9011)  MXARRY 

CHCRCF 

00289 

CO  TO  6100 

CHCRCF 

00290 

6020  CONTINUE 

CHCRCF 

00291 

VRITE  It.T6.9010)  MCCESC.IRR 

CHCRCF 

00292 

VRITE  (NT6.9011)  MXARRY 

CHCRCF 

00293 

GO  TO  6100 

CHCRDF 

0C294 

6040  CONTINUE 

CHCRDF 

00295 

R.TE  (NT6.9010)  IVP3C.IRR 

CHCRCF 

00296 

VRITE  (NT6.9041)  t*4 

CHCRCF 

0029? 

6100  CONTINUE 

CHCRDF 

00298 

VRITE  (NT6.9101)  I C  (1 )  ,  I  C(2) 

CHCRCF 

00299 

VRITE  (NT6.910?)  PARM.IPARM 

CHCRCF 

00300 

TRUE  (NT6.9103)  TRS.N4S 

CHCRCF 

00301 

VRITE  (NT6.9104)  ITYPE.M.N 

CHCRCF 

00302 

VRITE  (NT6.9900) 

CHCRCF 

00303 

GO  TO  8000 

CHCRCF 

00304 

C 

CHCRDF 

00305 

TP10  CONTINUE 

CHCRDF 

00306 

VRITf  INT6.8020) 

CHCRDF 

00307 

VR.TE  < NT 6 , 802 1 )  IROH.JC 

BCSCFA 

00013 

C 

CHCRDF 

00309 

0000  CONTINUE 

CHCRCF 

00310 

call  flush  (t  > 

CHCRCF 

00311 

c 

CHCRCF 

00312 

«K?0  FORMAT!?^***  DRCR  -  NO  TIP  TRAILING  EDGE  VELCCITY  POTENTIAL 

CAN  CHCRCF 

(.931  5 
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1  BE  COMPUTED.  ***  )  CHCRDF 

8021  FORMAT (5X.13HCOCRDI NATES  (12, 1H,  12, 1H)  )  CHCRDF 

4010  FCRMAT (53H0***  ERROR  -  WHILE  READING  THE  GEOCTRY  SCRATCH  FILE  A10  CHCRDF 
1,  15H,  ERROR  CCCE  =  14, AH  ***  )  CHCRDF 

*511  FCRMAT  (5X.32HAN  ATTEMPT  HAS  MACE  TO  READ  THE  A6,  8H  MATRIX.//)  CHCRDF 

*541  FORMAT (5X,S4HAN  ATTEMPT  HAS  MACE  TO  READ  THE  VEL.  POT.  ARRAY  NLM5E  CHCRDF 

1R  13, 1H.  )  CHCRDF 

9050  FCRMAT  (56H3***  ERROR  -  WHILE  WRITING  ON  THE  VEL.  POT.  SCRATCH  FILE  CHCRDF 

1  A10,  1SH,  ERROR  CCCE  =  U,4H  ***  )  CHCRDF 

9051  FORMAT (5X.36HATTEMPTI NG  TO  WRITE  VEL.  POT.  NL*«ER  13  )  CHCRDF 

9101  FORMAT (5X,*MATR IX  ID  =  *,  A10,  1 10)  CHCRDF 

9102  FCRMAT <5X, ^PARAMETERS  *,10E11.3,  /  IOX,*  (INTEGER)*,  I?,  9111  )  CHCRDF 

9103  FCRMAT (SX,*F1LE  SPACING  =  *,I3,*  MATRIX  S FACING  =  *,I3  )  CHCRDF 

9104  FCRMAT (SX,*MATR IX  TYPE  =*,A10,*>  DIMENSIONED  (*I4,2H  X.I4.1H)  >  CHCRDF 

9900  FORMAT (40  ERRO  OCCURRED  IN  WORD- FIT  SMOOTHING  SECTION.  *  )  FTNX1 

DC  CHCRDF 


00314 
00315 
0031  € 
00317 
00318 
00319 
00320 
00321 
00322 
00323 
00324 
00325 
00326 
00327 
00074 
00329 
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c 

c 

c 

<r 

c 


c 


SUfcROUTITC  FRI  NTR  (Tl  TL.  IHCCEiASRAY  ,K,  I  XB  ,MXB  ,MTB,  I  PNTRM)  PRINTS 

PRINTS 

Tin.  -  title  to  print  flu  the  array  prints 

IMCCi  -  MCtE  SHAPE  MACES  PRINTS 

ARRAY  -  ARRAY  TO  BE  PRINTED  PRINTS 

PRINTS 

DI*CM5ICN  ARRAY  (K,l) ,  TITL(3)  PRINTS 

CCMPLEX  ARRAY  PRINTS 

COKN  /FILES  /  NTS, NT6, INTAPE, INFSP,NFEAIC,NSPAIC,WCJUTP,  FILES 

1  IOUFSF,HCCESC,IVFSC,IGCC6C,IWTFSC,IAICSC  FILES 

CORACN  /CONTSL/  FREVEX,  CMACH ,  TIT1_E<8>,  FRVCECM,  FR  VMCCE,  DIHW,  CIHT ,  CONTSL 

1  DEFAULT  CCNTSL 

LOGICAL  FRvOEOt;  PR  VMCCE,  C1HW,  CIHT,  DEFAULT  CONTSL 

COMMON  /FRC8LM/  xmOH ,  MAXES ,  NTSLOP,  NGVALS  .SMOOTH.  NDEG,  CRCFIT ,  FRC8LM 

1  EXAIC.SueCV.PLYWXE  FRCBLM 

LOGICAL  SMOOTH ,  CRCFIT.EXAIC, SUB CV,  PLY WXC  FRCBLM 

COMMON  /AVAL  /  IKVAL.  ^  VAL  (20)  ,  «5S(20)  KVAL 

CIFCN5ICN  I PNTRM (2 . 50)  FRI NTS 

DIMENSION  PC  (2)  FRI  NTS 

CIME76ICN  S(50)  .  C  < SO)  PRINTS 

EQUIVALENCE  (S(l)  .BUFF  (1))  ,  (C(l)  ,  BUFF  (1251))  FRtNTS 

REAL  K1  PRINTS 

INTEGER  PAGE  PRINTS 

COAACN  /KVEUFF/  0FCXE.IBFCNT,  BUFF(J280)  SVCUFT 

DATA  PC  /  1  OH  PAGE  CCNTI.4HNUEB  /  FTNX1 

cata  blam;  /  1H  /  ftnxi 

DATA  XINIT  /  -1.0  /  FTNX1 

Ki  =  WVAL  (IKVAL)  PRINTS 

IFOtKS(IKVAL) -fC. XINIT)  K1  =  )«$(!KVAL)  FRINTS 

PAGE  =  0  PRINTS 

N  =1  PRINTS 

M  =4  PRINTS 

IF(M.CT.MfB)  M  :  MYB  FRINTS 

100  LINE  =  100  PRINTS 

200  CONTINUE  FRINTS 

DO  1400  IiIXB.MXB  FRINTS 

DO  300  J=N,M  PRINTS 

3  ( J )  =  0.0  FRINTS 

D(J)  =  0.0  FRINTS 

300  CONTINUE  FRINTS 

IF(LIF€.LE.50)  GO  TO  900  FRINTS 

PACE  =  PAGE  ♦  1  PRINTS 

LI>C  -  4  FRINTS 

.RITE  (NT6.3001)  TITLE. TITL, XMACH, K1  .IMCCE  FRINTS 

FRINTT- 

IF(PAGE.Ea.l)  go  to  too  prints 

VRITE  (NT6.9005)  PC  FRINTS 

CO  TO  800  FRINTS 

TOO  VR [ TE (NTS , 9005 )  PRINTS 

800  CONTINUE  FRINTR 

VRI  TE(NT6, 6006)  (BLAMC,  J,  J:N,M)  FRINTS 

WUTE(NT6,e007>  (8LAM(,  J=N,M)  PRINTS 

900  CONTI M _  FRINTR 

J$  =  I  PNTRM  (2 , 1 )  FRINTR 

I T  ( JS  .LE.  0)  GO  TO  1400  FRINTR 

ICX  r  I  PNTRM  (1  ,1)  FRINTR 

JE  rIFNTKMd  ,  l»t )  -  ICX  ♦  JS  -1  FRINTR 


00002 
00003 
ODOM 
00005 
00006 
00007 
00008 
00009 
00002 
00003 
00002 
00003 
00004 
00002 
00003 
00004 
00002 
00015 
00016 
00020 
00021 
00022 
00023 
00002 
00076 
00077 
00070 
00024 
00025 
00026 
00027 
0GC28 
00029 
00030 
00031 
00032 
00033 
00034 
00035 
00036 
90037 
0GG38 
0GC39 
OG040 
00041 
00042 
00043 
00044 
00045 
00046 
00047 
00048 
00049 
00050 
00051 
00052 
000  5  5 
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IFUC.Efl.O)  CO  TO  1400 

PRINTS 

00054 

DO  1000  J=J$,JE 

PRINTS 

00055 

Ut)  s  REAL  (ARRAY  (1 , 1 CX)  ) 

PRINTS 

00056 

DO)  =  AlMA'i  (ARRAY  (1  iICX) ) 

PRINTS 

00057 

tCX  =  JDX  >1 

PRINTS 

00058 

1000  CONTINUE 

PRINTS 

00059 

DO  1200  J=N,M 

PRINTS 

00060 

IF(S(J))  1300,1100:1300 

PRIKTR 

00061 

1100  CONTINUE 

PRINTS 

00062 

IF(D(J>)  1300,1200,1300 

PRINTS 

00063 

1200  CONTINUE 

PRINTS 

00064 

CO  TO  1400 

PRINTS 

00065 

1300  \4l I TE  (NT6.9013)  I ,  (S(J)  ,C(J) ,  J=N,M) 

PRINTS 

00066 

UtC  =  LIVC  ♦  1 

PRINTS 

00067 

1400  CONTINUE 

PRINTS 

00068 

M  =  H»4 

PRINTS 

00069 

M  s  N»4 

PSINTS 

00070 

iF(N.CT.tffB)  CO  TO  1500 

PRINTS 

00071 

IRH.CT.NTB)  M  =  tffB 

PRINTS 

00072 

IFO.INC.CT. 45)  CO  TO  100 

PRINTS 

00073 

V#UTE(NT6,6D06>  (BLAN(,  J,  J=N,H) 

PRINTS 

00074 

Mil  TE(NT6, 6007)  (BU»X,  J=N,M) 

"RINTS 

00075 

UNE  =  LI  ME* 3 

PRINTS 

00076 

CO  TO  200 

PSINTS 

00077 

1300  CONTINUE 

PRINTS 

00078 

RETURN 

PRINTS 

00079 

9001  FORMAT  (INI  ,2GX,6A10/  46X.*$MOOTHED  *,3A10/ 

46X,7H(  MACH  F5.3.5X, 

PRINTS 

00080 

1  12HREB.  FKEQ.  =,FB.5,  *  )*  /  52X,**€ftE 

SHAFE*.  13) 

PRINTS 

00081 

9005  FORMAT  (44X, 42  I1H-)  ,20X,A10,A4) 

PRINTS 

00082 

9006  FCRHAT  (4H0RCW,  A1 ,14X,  5HCHCRD,  13,  3(A1 ,22X,  5HCH0RC.  13)  ) 

PRINTS 

OOG83 

BOOT  FORMAT  (3X,  4  (A1 ,9X,4H<EAL,8X,9HtMACIt#RY>  ) 

PRINTS 

00084 

9013  FORMAT  (I4,8E16.8) 

PRINTS 

00085 

EM) 

PRINTS 

00G86 
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CURVE  00002 
CURVE  00003 
CURVE  00004 
CURVE  00005 
CURVE  00006 
CURVE  OGQOT 
CURVE  00008 
CURVE  00009 
CURVE  00010 


CURVE 

00011 

CURVE 

00012 

CURVE 

00013 

CURVE 

00014 

CURVE 

00015 

CURVE 

00016 

CURVE 

00017 

CURVE 

00018 

CURVE 

00019 

CURVE 

00020 

CURVE 

00021 

CURVE 

00022 

CURVE 

00023 

CURVE 

00024 

CURVE 

00025 

CURVE 

00026 

CURVE 

00027 

CURVE 

00028 

CURVE 

00029 

CURVE 

00030 

CURVE 

00031 

CURVE 

0003? 

CURVE 

00033 

CURVE 

00034 

CURVE 

0G035 

CURVE 

00036 

CURVE 

00037 

CURVE 

00038 

CURVE 

00039 

CURVE 

00040 

CURVE 

00C41 

CURVE 

00042 

CURVE 

00043 

CURVE 

00044 

CURVT 

00045 

CURVE 

00046 

CURVE 

00047 

CURVE 

00048 

CURVE 

00049 

CURVE 

00050 

CURVE 

00031 

CURVE  00052 


CURVE  00053 
CURVE  00054 
CURVE  00055 
CURVE  00056 
CURVE  000‘> 7 
CURVE  COO  5- 
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ACI.I)  =  SORTCT) 

IFCAd, I1.6T.EPS)  60  TOSCO 
AU.iTon  =  o.o 
CO  TO  1200 
goo  CONTINUE 
C 

JS  =  1*1 

DO  1100  J=JS. ITOT 
TXP  -  0.0 

IFd.EQ.l)  60  TO  1000 
DO  900  L=1,IM1 

■900  TMP  =  IMP  ♦  A(Ltt)  AA(Li  J) 

1000  A(I.J>  =  (Ad,J>-TMP)/A(I,I> 

1100  CONTINUE 
1200  CONTINUE 

c 

c  BACK  SUBSTITUTE  FCR  COEFFICIENTS 

C 

DO  1600  K=1,NC 
I  =  NC  -  K  ♦  1 
I  PI  =  I  ♦  1 
TMPl  =  0.0 
TNP2  =  0.0 

IF(A  (I.I1.6T.EPS)  60  TO  1300 
CH.I)  =  0.0 
CC2.I)  =  0.0 
60  TO  1600 
13CO  CONTINUE 

IF(I.EQ.NC)  60  TO  1500 
DO  1400  L=IP1.NC 
TMPl  =  TMPl  ♦  A(I  iU  *  Cd.U 
TMP2  =  TMP2  ♦  A<I,U  *  Ct2,U 
1400  CONTI  HE 

1500  continue 

CCl.n  =  (Ad.K>l)-TMPl>/Ad.I> 
C(2.I)  =  (Ad  i  ITOD-TMF2!  /A  (1  •  I ) 
1000  CONTINUE 
RETURN 
DC 


CURVE 

00059 

C1R  VC 

00000 

CURVE 

00061 

CURVE 

00002 

CURVE 

000W 

CURVE 

00004 

CURVE 

00065 

CURVE 

00006 

CURVE 

0006? 

CURVE 

00006 

CURVE 

00069 

CURVE 

000  TO 

CURVE 

000?1 

CURVE 

00072 

CURVE 

GOO  73 

CURVE 

00074 

CURVE 

00075 

CURVE 

00076 

CURVE 

00077 

CURVE 

00078 

CURVE 

00079 

CURVE 

00080 

CURVE 

00081 

CURVE 

00082 

CURVE 

00083 

CURVE 

00084 

CURVE 

00085 

CURVE 

00086 

CURVE 

00087 

CURVE 

00088 

CURVE 

00089 

CURVE 

00090 

CURVE 

00091 

CURVE 

00092 

CURVE 

00093 

CURVE 

00094 

CURVE 

00095 

CURVE 

00096 

CURVE 

00097 
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OVERLAY  (AF»C0X,1  ,10)  FCRCES 

PROGRAM  FORCCS  FCRCES 

C  FCRCES 

C  THIS  PROGRAM  CALCULATES  BOX  LIFTS,  SECTION  LIFTS.  TOTAL  LIFT,  FORCES 

C  APC  GENERALIZED  AIR  FORCES.  THE  PROGRAM  PRIST  READ  I  FORMAT  I  ON  FORCES 

C  from  the  geometry  scratch  file  and  the  moce  SCRATCH  file.  forces 

c  forces 

COMCN  /ARRAYS/  KBXCDW.LBXCCW.LBGXC.KBXCCT.LBXCDT.KJALFH.LJALFH,  ARRAYS 

1  KALPHA,KKERPA.,LKERP*.,KPNTRM,LPNTRM,KDEF$L,KELFHI,  ARRAYS 

2  LMCCES.KPNTjD.LPNTSt.KSCW.LSCW.KFNTCW.LPNTDW,  ARRAYS 

3  KDW.LCW.KTVP.LTVP  ARRAYS 

COMMON  /FILES  /  W5,NT6,INTAPE,If«P,NfU.lC,NSPAIC,NCUTP,  FILES 

1  I0UFSP,MCCESC,IVF5C,IGE06C,1WTF5C,IAICSC  FILES 

EBUI VALENCE  (IWTFSC.ITSLSO  FORCES 

COPPCN  /IOCCNT/  OFT_AIC,C6FAIC,WTGECH,WTGNAF1WTSLiWTBL,fRBOX,  IOCONT 

1  PRPAIC.PRSAIC.FRMCCS.FRCOEF.FRDW.PRSW.fRVP,  IOCONT 

2  M?BL .  FRDCP.  PRGNAF ,  PRGNAC ,  FRSL .  FRLW,  FRMrf,  PRCM  BCSFRB 

BJUI VALENCE  (PRIM,  PR CW)  IOCONT 

LOGICAL  OPUIC.QBPAIC.WTGECM.WTGNAF.WTSL.WTBL.FRBOX.fRPAIC,  IOCONT 

1  FRSAIC.  PRMGCS.  FRCOEF,  FRDW,  PRSW,  FRVP,  PRBL,  PRSL.FRGNAF,  IOCONT 

2  PRDCP.  PRGNAC.  FRUW.PRLW.PRNW.FRCM  BCSFRB 

CO*-<OH  /  KERN  /  ERR.MXSKRN.  IFXEKN.NPLKRN.NSPATK.fRCWEA  KERN 

COMMON  /KVAL  /  IKVAL.  WVALI20)  .  WS(20>  KVAL 

CCMKN  /PRCELM'  XMACH ,  PNCCES, NTSLClP, PKVALS.SMCOIH, NDEG. CRCFIT,  PRCBLM 

1  EXAIC.SUBCV,n_YWOCC  FRCSLM 

LOGICAL  SMOOTH ,  OR  CFI T .  EXA I C ,  SUBC  V ,  R.Y  WCCC  FRCSLM 

OCMMON  /  MQT.ES/  SYM.SYHT ,  MTY PEW.  MTY PCT  MXCCM 

COMON  /GECMTY/  COPLAN.  NSUBCV,  XSUBCV,  N5UBC2 .  NSUBCN,  P6URF,  GECMTY 

1  Bl, BIBETA, BIS. B1BTAS.VLAX.VOZ.PSIW,  GECMTY 

2  MXBW,  MXBBW,  MYBW,  Wf  EBW,  MXESW,  MYBSW,  MTBBSW,  GECMTY 

3  I XBW,  XCENTR  GECMTY 

LOGICAL  COPLAN  GECMTY 

CCMMOH  /GEOC  /  TLAX.TLAZ.FSIT.MXBT.WTBT.MYBBT.MXBST.MYBST,  GEOC 

1  MYBBST .  I X8T ,  I XBST ,  CAFL  GEOC 

COMCN  /TAPEIO  P'FS.PMS.LS.PAR.  ID  (20)  , NID,  ITYPE.LRS.LWS.M.N,  TAPEIO 

1  PARM(IO)  .  IRR  TAFEIO 

DIMENSION  IPARM(IO)  TAPEIO 

QUI VALENCE  (PARM.IPARM)  TAPEIO 

COMMON  /CHECKER/  CPPCPR,GE0CPR,MCXCfR,AICCfR,P*6CPR,SKPR,GAFCFR  CHECK FR 
LOGICAL  DPPCTR,  GEOCFR ,  MOCCFR,  AICCPR . P4M5CFR,  SMCFR,  CAFCFR  CHECKER 

EBUI  VALENCE  (CHECKER,  GAFCPR)  FCRCES 

LOGICAL  CHECK  PR  FCRCES 

Cl  ME  PCI  ON  RX5F  (1350)  FCRCES 

EBUI  VALENCE  (RVSF.BLFF)  FORCES 

COMPLEX  RW?F  FCRCES 

COMMON  /LOCU  WVL  FCRCES 

COMMON  8 LAP*  (1 )  FCRCES 

DIMENSION  TITL12)  FCRCES 

C  FCRCES 

C  FEXLOC  ( (MYBWtMYBT)  *NSU6DV)  ,  TEXLOC  (SAME)  FCRCES 

DIMENSION  FEXLOC (250).  TEXta (250)  FCRCES 

C  I PNTRM  (2 ,  PROWS)  FCRCES 

C1K.NSICN  lPP(TfiM(2,100)  FCRCES 

C  I BOXW(Pf.CWS,  150/20)  ,  I BOXT  (90,150/20)  FCRCES 

DIMENSION  IBOXW(150,8)  .  I  BOXT  (90.0)  FCRCES 

C  1BXCCF(NCCL$>  .  IBXCC(NCCLS)  ,  IBXCDA(NCCL$>  FCRCES 

DIMENSION  IBXCCF(150),  IDXCCU50),  IBXCCA(150)  FORCES 


00002 

00003 

00004 

00005 

0G006 

00007 

00008 

00002 

000G3 

00004 

00005 

OOOG2 

00003 

00011 

00002 

00003 

00001 

00005 

00006 

00007 

00002 

00002 

00002 

00002 

00003 

00004 

00002 

00002 

00003 

00004 

00005 

00006 

00002 

OCOG3 

00002 

00003 

00004 

00005 

00002 

GG0G3 

00022 

00023 

00024 

00025 

00026 

00027 

00028 

00029 

00030 

00031 

00032 

00033 

00034 

00035 

00036 

00037 

00036 


3200 


u  u 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 

c 


DEFSL  (2  <  P®OXES)  i  CEFITE(NCCLS) 

DIMENSION  DEFSL (2, 1000),  DEFLTEC50) 

ALMA  {NCCLS*2*NSURF)  ,  I J  ALM  (SAME) 
TSLFN(«OXES) 

DIMENSION  TSLFN(lOOO) 

DIMENSION  ALMA (200) ,  UALM<200) 

DE1.MI  (POOXES)  ,TVF<NCCLS14NCCLS2*NSUBDV> 
COMPLEX  DEL  MI  a 000)  ,  TVP<250) 

BW.IF7<PC0XES>  ,  SLIFT(NCCLS*tNOCES> ,  OEV 
COMPLEX  B«-IFT(1000>,  SLIFTUOO),  TLIFT,  OEK 
AFROWtNMGCES) 

I  A ER CJW 120) ,  BL2,  TLIFT1  .TLIFT2 

DELCP(NBOXES) 

COMPLEX  DELCF(IOOO) 

CRAFC  (NMCCESWNCCES)  ,  CPPAFC(SAME) 
DIMENSION  OPAFC (400) ,  0PPAFC(400) 

DIMENSION  AFC  (2) 

EBUI VALENCE  (AFCSTR , AFC) 

COMPLEX  SECMCM(IOO) ,  CAF 

VTTE(NCCLS) 

COMPLEX  VP’TE(50),VPLE,  TEMPI,  TEMP2,  TEMF3,  BL 

LOGICAL  MKEAC.fiA^CIN.MXWUT.RAMIOU 

LOGICAL  BLPCED 

COMPLEX  XIPCEF 

DIMENSION  XJPCF7<2> 

EQUIVALENCE  (XIPCEF.XIPCFF) 

CO**ON /RVEUPT/  BFCCCE,  I BFCWT ,  BUFF  (3280) 

MMRCAD  =  .FALSE. 

RAPCIN  =  .FALSE. 

MX*?  IT  =  .FALSE. 

RAPCOU  =  .FALSE. 


OEmFIPfCCES^NOCE) 
OENAF(AOO) , 


FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FOCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

BCSFRB 

BCSFRB 

BCSFRB 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 

ftnxi 

FTNX1 

RV6UFF 

FORCES 

FORCES 

FORCES 

FORCES 

FORCES 


00039 
00040 
00041 
00042 
00043 
00044 
00045 
00046 
00047 
00048 
0b049 
00050 
00051 
00052 
00053 
00054 
00055 
00056 
00057 
00008 
00009 
00010 
00058 
00059 
00060 
00061 
COD  62 
000 ^9 
000(0 
OOOC2 
00064 
00065 
00066 
00067 
00068 


**  =  WVALUKVAL) 

BDEEB  =  WTBL  .CR.  PRBL  .CR.  PRSL  .CR.  PRDCP  .CS.  PRCM 
TUC8ET  -  (2. 0*81  BETA) /81 
TWRB  =  TWC8ET/B1 

CONSTANTS  FCR  ACARD  CEPERALIZB  sEROC.NAMIC  COEFFICIENTS, 
BASED  ON  WING  SEMI -SPAN 
S  *  MTBW  *  BIBETA 

83  s  S*S«o 

54  i  S«S3 

BS3BET  =  -81BETA/S3 
BKS4BT  *  0.0 

IF  OK*.  .EQ.  0.)  CO  TO  5 

BK54BT  s  -I.  *(B14ClBETA)/OKVL*54) 

5  CONTINUE 
MVP*  *  M40CES 
MAX  *  NVPS  *  MODES 


REWIND  MCCC5C 
(♦4SPCE  =  0 


FCRCES  00069 
FCRCES  00070 
BCSFRB  00011 
FCRCES  00072 
FCRCES  00073 
BCSFRA  00001 
BCSFRA  00002 
BCSFRA  00003 
FCRCES  00076 
FCRCES  00077 
FCRCES  00078 
BCSFRA  00004 
BCSFRA  00005 
FCRCES  00079 
BCSFRA  00006 
FCRCES  00082 
FCRCES  00083 
FCRCES  00084 
FCRCES  00085 
FCRCES  00086 
FCRCES  00087 
FCRCES  00CS8 
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c 

C  BEAD  THE  POINTERS  FROM  ’HE  HOC  ESC  FILE. 

C 

CALL  RDINTT 
I  TYPE  =  3HM1XED 
KXARRY  s  6HIPNTRM 

CALL  REACMXOMCCESC.MWEAO.fiAKCIN.WS.WC.LS.WR.e.NID.ItMTYPE. 
l  LRSi  IPNTRM.M<  N|  PARMt  IRR) 

ICVLAP  =  I  FARM (3) 

W>NTRS  =  N 

MXB  =  NPNTRS  -1 

MOB  -  MAWOMOBW.MOBT) 

NBCKES  =  MTB  *  MXB 
IF(IRR.NE.O)  CO  TO  6G20 
C 

c 

REWIND  ICEC6C 
C 

C  RCAD  BOX  CCCES  INTO  STORAGE  FROM  GEOMETRY  SCRATCH  FILE 

C 

CALL  RDINIT 
I  TYPE  -  90MIXED 
KXARRY  =  6HIBOXW 

CALL  REACMX(IGEC6C,M>REAC,RAW5IN,ftf-S,f*<S,LS,N«,150,NID,ID,mPE, 
1  LRS>  IBOXWiMi  Ni  FARM,  IRR) 

iFOIRfi.fC.O)  CO  TO  6010 
C 

WES  =  1 

IF(NSLRF.EB.1.CK. COFLAN)  CO  TO  10 
WLS  =  2 
C 

CAU  RDINIT 
I  TYPE  =  6HMIXEC 
KXARRY  =  6HIBOXT 

CAU  RODMX(ICEQ6C,M*EAC,RANDIN,NRS,W6,LS,W4;,  90,NID,ID,ITYFE, 
1  LRS.IBOXT,M,N,FARM,IRR) 

IFURR.TC.O)  CO  TO  6010 
C 

10  CONTINUE 
C 

C  READ  THE  TEA.OC  AND  FE54.0C  ARRAYS  FRC*4  THE  CECHETRY  SCRATCH 

C  FILE.  THESE  ARE  NEEDED  TO  INTERPOLATE  VELOCITY  POTENTIALS  AT 

C  BOX  CCCES. 

C 

CALL  RDINIT 
I  TYPE  =  5HMJXED 
KXARRY  -  6HFEXLOC 

CAU  READMXdCECSCiMWEAD.RAfCIN,  WSif*6(LS»TM5»l  *  NIC.  I  Di  I  TYPE, 
l  LRS.FEXLOC,M,N,PARM,IRR> 

IF(IRR.NE.O)  CO  TO  6010 
C 

CALL  RDINIT 
l  TYPE  =  SHMIXED 
KXARRY  r  6HTEXLOC 

CALL  READMX<ICCC6C,M*REAC,RANBIN,WS(W«,LS.W«,1.NID,ID,JTYPC, 

1  LRS.TEXLCC.M.N.FARM.IRR) 

IF(IRR.NE.O)  CO  TO  6010 


FORCES  00G89 
FORCES  00090 
FORCES  00091 
FORCES  00092 
FORCES  00093 
FORCES  00094 
FORCES  00095 
FORCES  00096 
FORCES  00097 
FORCES  00098 
FORCES  00099 
FORCES  00100 
FORCES  00101 
FORCES  00102 

forces  00103 

FORCES  00104 
FORCES  00105 
FORCES  00106 
FORCES  00107 
FORCES  001C8 
FORCES  00109 

forces  00110 
forces  00m 
forces  00112 

FORCES  00113 

forces  0011 4 

FORCES  00115 
FORCES  00116 
FORCES  00117 
FORCES  00118 
FORCES  00119 
FORCES  00120 
FORCES  00121 

forces  00122 

FORCES  00123 
FORCES  00124 
FORCES  00125 

forces  00126 
forces  00127 
forces  0012a 
forces  ooi?t 

FORCES  00130 
FORCES  00131 
FORCES  00132 

forces  00133 

FORCES  00134 
FORCES  00135 
forces  00136 
FORCES  00137 
FORCES  00138 
FORCES  00139 
FORCES  00140 
FORCES  00141 
FORCES  00142 
FORCES  0014  3 

forces  001 44 

FORCES  0014  5 
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CALL  RDINIT 
ITYPE  a  5HHIJCD 
******  -  «HAL«HAS 

lF<IRR.tc.G)  CO  TO  6010 

CALL  RCINIT 
ItYPE  =  3HMIXED 
*****Y  =  ®«JAL*H 

CALL  RUCMX«CE06C.H*WD.KA«rH,»rS,^,LSf»K:<1,tflC,IC  ITYPE 
‘  LRS*l4ALTH»H*N,PARM,IRR) 

^L'Ti  S  N 

NALFHW  a  IPARM(5> 

NALfffT  a  N  ~  NALR-IW 
IFIIRR.nE.O)  CO  TO  6010 

C 

c  At®  TD»-«:  ARRAYS  SO  THAT  THERE  ARE 

l  VAL'*S  rcK  «NSW»WVIC05  CHORES  OCY. 

IF<t6L*CV.£a.l)  CO  TO  130 
XSLICE  a  NSUBCV-IXBW 
•»ca  a  NSUJCN 
**<*-*  a  HTBW  ♦  HCBT 

OO  110  lst,NCCLS  1 

TOtOCtI)  =  (TDQ.OC  (Jca,)+XSLIDE)/XSUBCV  1 

^l.QC«)  a  (FEXLOC ( JCCL) ♦XSL:CE)/XSLBCV  1 

Jca.  =  jca.  ♦  nsubov  1 

no  CONTINUE  I 

MO  CONTINUE  I 

REWIH3  ITSLSC  F 

DO  ?50  IT3L0P=1,NTSLC P  F 


READ  THICKNESS  SLOPE  FUNCTIONS 


CALL  RCINIT 
I  TYPE  =  4HREAL 
******  =  6HTSLFN 

*r«»*R.*C.0)  Co  TO  6040 

C  ZtKO  our  THE  AIR  FCRCES  ARRAY 

DO  ISO  Jst.MAX 
HO  CCNAFOJ  =  <o.,o,) 

c  LOC4.  ON  tMCCR  cr  MOCC  SHAPES 

DO  6  SO  ,‘*«CCtS 


fcrces 
-E.  forces 

FORCES 

forces 

forces 

fcrces 

forces 

forces 

FORCES 

FORCES 

FCRCfcs 

forces 

forces 

forces 

forces 

fcrces 

forces 

forces 

fcrces 

FCRCES 

fcrces 

FCRCES 

fcrces  i 
fcrces  I 
fcrces  I 
fcrces  I 

FCRCES  ( 
fcrces  I 
fcrces  c 
fcrces  c 
fcrces  c 
fcrces  c 
fcrces  c 
fcrces  0 
forces  0 
forces  0 
fcrces  a 
forces  a 
fcrces  a 
fcrces  a 
forces  a 
fcrces  a 

FCRCES  OC 

forces  og 
forces  oo 

FORCES  00 
FCRCES  00 

forces  oo 
fcrces  oo 
forces  oo: 
forces  oo: 
fcrces  001 
forces  ooi 
forces  ooi 
fcrces  ooj 
forces  002 

FORCES  002 


CCS  00146 
CES  00147 

:es  00148 

:E3  00149 

:es  00150 

23  00151 
S3  00152 
Es  00153 
ES  00154 
a  00155 
ES  00156 
SS  001 5T 
ES  00158 
ES  00159 
ES  00160 
ES  00161 
ES  00162 
ES  00163 
ES  00164 
3  00165 
3  00166 
S  00167 
S  00168 
S  00169 
S  00170 
S  00171 
S  00172 
S  00173 
5  00174 
i  001 75 
J  00176 
i  00177 
>  00178 
t  OClTg 
00180 
00181 
00182 
00183 
00184 
00185 
00186 
00187 
00188 
00189 
00190 
00191 
00192 
00193 
00194 
00195 
00196 
00197 
00196 
00199 
00200 
00201 
00202 
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c 

c 


c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 


c 


c 

c 

c 


FORCES 

00203 

GET  NCCE  SHAPE  NH  FRCM  HCCCSC  SCRATCH  FILE 

FORCES 

00204 

CALI.  HOI  HIT 

FORCES 

00205 

iFOW.Efl.l)  N<S  =  W6PCE 

FORCES 

00206 

I  TYPE  =  4HREAL 

FORCES 

00207 

MXARRY  =  6HDEFSL 

FORCES 

00208 

CALL  REACMX<.(GCESC,H*<EAC,RAfCIN,NFS,M«,LS,T*R,2,NID,ID,ITYPe, 

FORCES 

00209 

1  LRS.CEFSL.  H,N,PARM,IRR) 

FORCES 

00210 

IF (IRR.fC.O)  CO  TO  €020 

FORCES 

00211 

FORCES 

00212 

FORCES 

00213 

FCRCES 

00214 

LOOP  CN  VELOCITY  POTENTIALS 

FORCES 

00215 

REWIfC  IVP5C 

FCRCES 

00216 

FCRCES 

00217 

DO  €00  JVP=1,NVPS 

FCRCES 

00218 

FCRCES 

00219 

READ  CNE  SET  OF  VELOCITY  POTENTIALS 

FORCES 

00220 

CALL  RCINIT 

FCRCES 

00221 

I  TYPE  =  4HREAL 

FCRCES 

00222 

MXAFRY  =  WCELPHI 

FCRCES 

00223 

CALL  READMXd  VPSC,>WEAC,fiANDIN, TFS,  T44S,  LSiMNR  ,2,NIDi  IDi  ITYFEi 

FCRCES 

00224 

1  LRSt  DELTHI  iM,  N,  PARMi  IRR) 

FCRCES 

00225 

IF(IRR.ME.O)  CO  TO  €030 

FCRCES 

0C226 

FCRCES 

00227 

CALL  RCINIT 

FCRCES 

00228 

I  TYPE  =  4HSEAL 

FCRCES 

00229 

KXARFY  =  3HTVP 

FCRCES 

00230 

CALL  REACMX(IVPSC,M*EAC,RANEIN,TfS,T*6.LS,T*«,2,NID,ID,!TYPE, 

FCRCES 

00231 

1  LRS.TVP.M.N,  FARM,  IRR) 

FCRCES 

00232 

FORCES 

00233 

IF(IRR.NE.O)  CO  TO  €030 

FCRCES 

00234 

FORCES 

00235 

COCENSE  THE  TRAILING  EDGE  VELOCITY  POTENTIAL  ARRAY  TO 

FORCES 

00236 

UNSLBCIVICEE  BOXES. 

FORCES 

00237 

ALSO  ZERO  OUT  THE  SECTIONAL  GENERALIZED  FORCES. 

BCSFRB 

00012 

bcsfrb 

00013 

MTV  PS  =  HTBW  ♦  MYBT 

BCSFKB 

00014 

DO  210  1=1 ■  NT  VPS 

BC3FRB 

00915 

SECHCXtn  =  (0..0.) 

BCSFRB 

00016 

210  CONTINUE 

bcsfrb 

0091  7 

FORCES 

002 3o 

IF(NSUBCV.EO.l)  CO  TO  220 

FORCES 

00239 

XCL  =  NSUBCH 

FCRCES 

00240 

DO  215  l=l,NTVPS 

FCRi.ES 

00242 

TVPCI)  =  TVP(JCCL) 

FCRCES 

00243 

uca  =  uca  ♦  Nsuecv 

FCRCES 

00244 

215  CONTINUE 

FCRCES 

00245 

220  CONTINUE 

FORCES 

00246 

FORCES 

00247 

ZERO  OUT  THE  SOX  LIFT  ARRAY 

FCRCES 

00248 

FCRCES 

00249 

IF(>*t.NE.l)  CO  TO  240 

FCRCES 

0C230 

IF  (.NOT.  BLNEEC)  CO  TO  240 

FCRCES 

00251 

ttX  r  JPNTRMd  .NFNTRS)  -  1 

FCRCES 

00252 

DO  230  1=1  ,N6X 

FORCES 

00253 

CELCPd)  =  <0.,0.) 

FCRCES 

00254 
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Z3C  dxlift«>  =  to.,o.) 

240  CONTINUE 


THE  FOLLOWING  BLOCK  CF  CCCE  COMPUTES 
BXUFT  -  BOX  LIFTS 

SLIFT  -  SECTION  (CHORD)  LIFTS 

TUFT  -  TOTAL  LIFT 

CEWF  -  GENERALIZED  AIRFCRCES 


AFROW(JVP)  =  (0.,0.) 

A  FROM  =  CURRENT  ROW  CF  GENERALIZED  AIRFCRCES 

SET  UP  INITIAL  COCITICNS  FOR  DOUBLE  LOOP  OVER  THE  ENTIRE 
BOX  PATTERN 

I8XCDF  s  FORWARD 

IBXCD  =  CENTER  RCV6  OF  BOX  CODES,  EXFAtCED 
IBXCDA  =  AFT  / 

VR.E  =  VELOCITY  POTENTIAL  AT  BOX  LEADING  EDGE 
VPTE  =  ARRAY  CF  BOX  TRAILING  EDGE  VELOCITY  POTENTIALS 

DO  365  I#>=1,NFIS 
IF  (N«>.Ea.2>  GO  TO  243 
I  SR  OX  =  1 
NBXA  =  I  PNTRM(1 ,2) 

CALL  DCCCER(IBCXWl130,ISRa*,l.ISfi0WA,NBXA,.F., IBXCDA) 

tax  =  texA 
CO  TO  250 
CONTINUE 

I  SR  OX  =  <IXBT-IX8W)/NSUBGV  ♦  t 

IX8UT  =  I  SR  OX 

I  OCX  =  I  SR  OX  ♦  ICA/LAP 

NSXA  s  IPNTRMCl ,  IDEXM )  -  I PNTRMU , I DEX) 

ISUBT  =  2-IX8ST 

CALL  DCOCER (IBOXT (ISUBT ,1 ) iLBXCCT , ISROWAil , ISROWA,f®XAi  .F., IBXCDA) 

»CX  =  f«XA 
CONTINUE 

DO  2  TO  JCa  *  l.NBXA 
IBXCD  (JCCL)  s  IBXCDA  (JCa) 

IF  (IBXCCA(JCa)  .EB.  I)  GO  TO  260 
VPTE  (JCCL)  =  XIWEF 
OEFLTC(JCCL)  =  XIWEF 
CO  TO  2  TO 
I  CONTINUE 

VPTE  (JCCL)  s  (0.,0.) 

I DC  s  JCCL 

DEFLTE(JCa)  *  DEFSL(1  >  I  DC  >  ♦  DEFSL(2,IDC)*Bl*(FEXLOC(JCa)-i  .0) 

I  CONTINUE 


LOOP  ON  ROUS  OF  THE  BOX  PATTERN 
IF(NP.ED.2>  CO  TO  275 
IRS  =  I 


FCRCES 

FORCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FORCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 

FCRCES 


00255 

00256 

00257 

00258 

00259 

00260 

00261 

00262 

00263 

00264 

00265 

00266 

00267 

00268 

00269 

00270 

00271 

00272 

00273 

00274 

00275 

00276 

00277 

00278 

00279 

00280 

00281 

00282 

00283 

00284 

00285 

00286 

00287 

00288 

00289 

00290 

00291 

00292 

00293 

00294 

00295 

00296 

00297 

00298 

00296 

00300 

00301 

0L3O2 

00303 

00304 

00303 

00306 

00307 

00308 

00309 

00310 

00311 
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NXBT  =  MXBW 

FORCES 

00.312 

IFICOPUAN)  NXBT  =  NXBT 

FCRCES 

00313 

N5CV6  =  NXBT 

FCRCES 

00314 

CO  TO  280 

forces 

00315 

2T5  CONTINUE 

FORCES 

00316 

IRS  =  <1  XBT-I  X8W) /L6UBCV  ♦  1  ♦  IOVLAP 

FCRCES 

0031 T 

MOT  =  NXBT  ♦  ICWUP 

forces 

00318 

am  continue 

forces 

00319 

DO  560  IRCVfcIRS.NXBT 

FORCES 

00320 

c 

FCRCES 

00321 

C  TRANSFER  BOX  CCCES  TO  CCRKECT  ARRAYS 

F<R  NEW  ROM 

FCRCES 

00322 

»€xf  =  *ex 

FCRCES 

00323 

HSX  =  K«XA 

FCRCES 

00324 

IF  (»6XF  .05.  0)  CO  TO  315 

FCRCES 

00325 

DO  310  JCCL  =  l.NBXF 

FCRCES 

00326 

310  IBXCDF(JCCL)  =  IBXCDIJCaJ 

FCRCES 

00327 

315  CONTINUE 

FCRCES 

00328 

IF  {f«X  .03.  0)  CO  TO  325 

FCRCES 

00329 

DO  320  JCCL  =  I.NBX 

FCRCES 

00330 

320  IBXCC(JCa)  =  IBXCDA(JCa) 

FCRCES 

00331 

325  CONTI NUE 

FCRCES 

00332 

IF  (IRON  .03.  NXBT)  CO  TO  335 

FCRCES 

OOS’X 

I  SR  CM  =  I  SR  CM  ♦  1 

FCRCES 

00334 

IF<NP.EQ.2)  CO  TO  330 

FCRCES 

00335 

f€XA  =  IPNTRM<1,ISKCM+1)-IPNTRM<1  ,  !SftOM)  +  I  PNTRM(2,  ISRCMJ-1 

FCRCES 

00336 

CAUL  DCCCER  (IBOXW.150,  ISR0M,1 ,  ISGOM,  IfiXA, 

,.F.,IBXCCA) 

FCRCES 

00337 

CO  TO  340 

FCRCES 

00338 

330  CONTINUE 

FCRCES 

00339 

IDEX  =  I  SR  CM  ♦  ICVLAP 

FCRCES 

00340 

WXA  =  IPNTRMd  ,ICEX*1)  -  I  PNTRMfl ,  ICEX) 

♦ 

I PNTRMC2,  ICEX)  -  I 

forces 

00341 

I  SLOT  =  2-IXBST 

forces 

00342 

CALL  DCCl.'R  (IBOXT  JISUBT  ,1 )  .LBXCET  ,  ISROM 

,1, 

1 1  SR  CM ,  M5XA ,  ,F. ,  IBXCCA) 

forces 

30343 

CO  TO  340 

forces 

00344 

335  CONTINUE 

FCRCES 

00345 

t«XA  i  0 

FCRCES 

00346 

340  CONTINUE 

FCRCES 

00347 

C 

FCRCES 

00348 

ITRCW  =  IRON 

FCRCES 

00349 

IFINP.Ea.2)  I TROW  r  [ROW  -ICVcAP 

FCRCES 

00350 

C 

FCRCES 

00351 

C  LOOP  ON  CHORDS  OF  THE  BOX  PATTERN 

FCRCES 

1.'35? 

IF  (N3X  ,E9 .  0)  CO  TO  560 

FCRCES 

.3353 

DO  550  jca  =  t,«SX 

FCRCES 

30354 

C 

FCRCES 

00355 

IF  (IBXCC(JCa)  .NE.  t>  CO  TO  550 

FCRCES 

00356 

I DC  =  LOCSCWURCW.JCa,  IPNTRM.LPNTRM.l.LPNTRH) 

FCRCES 

00357 

IF  <1  DC  .Ea.  0)  CO  TO  9*0 

FCRCES 

003S8 

C 

FCRCES 

00359 

C  CET  THE  SUBSCRIPT  TO  USE  IN  THE  EDGE  ARRAYS,  JJ 

FCRCES 

00360 

JJ  =  jca 

FCRCES 

00361 

IF  (NP  .Ea.  2)  CO  TO  350 

FCRCES 

00362 

IF  (  .NOT.  CCPLAN)  CO  TO  355 

FCRCES 

00363 

IF  (JJ  .CT.  WTBT)  CO  TO  355 

FCRCES 

00364 

IF  (TEXLCC(JJ)  .CC.  FLQATUTROW)  )  CO  TO  355 

FCRCES 

00365 

3 SO  JJ  s  JJ  ♦  HTEW 

FCRCES 

00366 

353  CONTINUE 

FCRCES 

00367 

C 

FCRCES 

00368 

n  rt  ft  ft 


C  DETER  MI  NE  BO*  LEADING  EDGE  VALLES 

IF  (FEW_OC(JJl  .W.  FLOAT  IITRCM-l)  >  QO  TO  410 
c  BOK  LEADING  EDGE  IS  INTERNAL  TO  THE  PLATFORM 

VFLE  *  VPTEOCCL) 

DEFILE  s  deflteuccl) 

c  TBOK^S  ON  PLANFCRM  LEADING  EDGE.  IS  IT  lAfLUENCED  BY  THE  HAKE- 

410  CONTINUE  _ „ 

JF  (  JJ  .EO.  JCCL  .OR.  .NOT.  CCFLAN)  GO  TO  420 


C 

c 

c 


LEADING  EDGE  cr  SECOC  TLAfFCSH.  VB.CCI.Tf  POTENTIAL 
CCHfVTED  FROi  HAKE  EQUATION. 

KDKVL  =  (FEXLOCOJ1  -  TEXLCCOCail  *  **VL 

VR.E  =  TVPCJCCU  ♦  CNPtX«COS<XDKH.».-SINtWKVL)> 

CO  TO  425 

LEADING  EBCE  CF  SECOC  PLAffCRM  Cf  SPATIAL  ANALYSIS 
CR  LEADING  EDGE  Of  FIRST  PLAfFCRM  (WING) 

420  CONTINUE 

vple  *  ca.,o.) 

425  CONTINUE 

TEST  FOR  SINGLE  BOK 

IF  (TEKLOCOJ)  XT.  PLOATtlTROUM)  )  GO  TO  430 
BOK  IS  A  SlMP.E  LEADING  EDGE  BCR 
IDA  =  LCCSBW<IRa*l.JCCL,  tPNTRM.LPNTRM.l  XPNTRM) 

IF  (ICA  .€0.  0)  GO  T0  9TO 

SLOPE  =  Bl*G€F5L(2.IBO 

»IF  s  FLOAT (l  TROW)  -  FER.OCU4) 

CEFLLE  s  CEFSLU.IDC)  -  SLCFE  *  XDIF 
GO  TO  450 

SINGLE  BC*.  GET  LEADING  A»C  TRAILING  VALLES 
430  CCNTINLE 

S^eVcEfS^IK^'sLCFE  4  (FLOAT UTPOW)  -  FE*L<XU4» 

DEFLTEtJCO.)  =  CEFSLI1 1  IDCl  ♦  SLOPE  *  (TE*LCC(JJ>  -  FLOAT (ITRCV) ) 
CO  TO  500 

DETERMINE  BOK  TRAILING  EDGE  VALLES 
440  CONTI  HE 

IF  (TEKLOC(JJ)  XT.  FLOAT(ITROMl)  >  CO  TO  460 


BOK  TRAILING  EDGE  IS  INTERNAL  TO  THE  PLAfTCRM 
IDA  *  LOCSDWUROHU.JCCL,  IFNTRHXPNTRHi  I,  LPNTRM) 

450  CONTINUE 

vnEUCCLI  =  .5  *  (DELWKIDO  ♦  DELPHI  (IDA)) 
tOLTEIJCCU  -  0.5*(DEFSL(I  iIDC)  ♦  OEPSL  (1 » 1  DA)  1 
CO  TO  500 

C  BOK  IS  ON  SLRFACf  TRAILING  EDGE 

4tt  CONTINUE 

VPTE(JCCL)  *  TVF(JJ) 

BLCFE  *  BlACEFSLtt.lDC)  . _ , 

eEFLTC(JCa)  *  CCFSLd.lDC)  >  SLOPE  *  <TE».0C<JJ>  -  P\.QATUTRCN>> 

C  BOK  LEADING  AiC  TRAILING  EDGE  VALUES  ARE  COMPUTED.  GET 
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00369 
003TO 
OOSTl 
00372 
00373 
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00375 
003T6 
00377 
00378 
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00392 
00393 
00394 
00395 
00396 
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00402 
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00410 
00411 
00412 
00413 
00414 
00415 
00416 
00417 
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00422 
00423 
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00425 
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c 

ALfHA,  THE  AREA  MULTIPLIER 

FORCES 

00426 

500  CONTINUE 

FORCES 

00427 

IF(NP.Efl.2)  CO  TO  505 

FORCES 

00428 

NAS  a  1 

FORCES 

00429 

HAL  =  NALWW 

FORCES 

00430 

CO  TO  506 

FORCES 

00431 

c 

FORCES 

00432 

S35  CONTINUE 

FORCES 

00433 

NAS  =  NAL«HW  ♦  1 

FORCES 

00434 

NAL  s  NALW 

FORCES 

00435 

506  CONTINUE 

FORCES 

00436 

c 

FORCES 

00437 

ALFM  =  1.0 

FORCES 

00438 

JCCHP  =  JCCL*512 

FORCES 

00439 

JCCMPl  =  JCCMP»512 

FORCES 

00440 

DO  510  I=NAS«NAL 

FORCES 

00441 

IF  (1  JALFHtI)  .LT.  JCCNP)  CO  TO  510 

FORCES 

00442 

IF  (IJALtH(I)  .CT.  JCCNP1  )  CO  TO  520 

FORCES 

00443 

IF  (IjALFH(I)  .NE.  JCCHP+ITRCW)  CO  TO  510 

FORCES 

00444 

AL»H  =  ALWA(l) 

FORCES 

00445 

CO  TO  520 

FORCES 

00446 

510 

CONTINUE 

FCRCES 

00447 

520 

CONTINUE 

FORCES 

00448 

IF(PI_YW00C)  ALW  =  1.0 

FORCES 

00449 

c 

FCRCES 

00450 

c 

CONFUTE  TEH  PI  =  Kl*ALfHA*CI)*(CELTA  PHI) 

FCRCES 

00451 

W  =  CMPLX(-AIMAC(CELFHI(IDC)),  REAL  (DELPHI  (1DC) )  ) 

FCRCES 

00452 

TEMPI  =  TEMPI  *  <*KVL*ALfH> 

FCRCES 

00453 

c 

FCRCES 

00454 

IF(7*4.AC.l)  CO  TO  530 

FCRCES 

00455 

c 

ARE  BON  LIFTS  DESIRED  - 

FCRCES 

00456 

IF  (.NCR.  BLAEED)  CO  TO  530 

FCRCES 

00457 

BR.IFTODO  =  (TEMPI  ♦  ALfH*(VFTE(JCCL>-VfLE>  )*TUCBET*  TSLFN(IDC) 

FORCES 

00458 

CELCP(IDC)  =  BXLI FTU  DC)  /  (ALPH*81 ) 

FCRCES 

00459 

550 

CONTINUE 

FCRCES 

00460 

c 

FORCES 

00461 

TEMPZ  =  DEFLTE(JCa)*VPTE(JCa)  -  DEFUL*  VFLE 

FCRCES 

00462 

TEMP3  =  (B1*ALFH*CEFSL(2,IDC>>  *  DE.'VKIDC) 

FORCES 

00463 

CAF  =  (TEMPI *CEFSL<1, ICC)  ♦  TEMP2  -  •rMP3>  *  TSLFNUDC) 

BCSFRB 

00018 

AFRCW(JVP)  =  AFRCW(JVF)  ♦  CAF 

BCSFRB 

00019 

c 

BCSFRB 

00020 

SEOOA(JJ)  =  SECMCM(JJ)  ♦  CAF 

BCSFRB 

00021 

c 

BCSFRB 

00022 

c 

FCRCES 

00466 

550 

CONTINJE 

FCRCES 

0U467 

c 

OC  OF  LOOP  CH  CHORDS  OF  THE  BOX  PATTERN,  FROM  340* 

FCRCES 

00468 

560 

CONTINUE 

FCRCES 

00469 

c 

ETC  OF  LOOP  ON  ROUS  OF  THE  BON  PATTERN,  PROM  2 TO* 

FCRCES 

00470 

c 

FORCES 

00471 

565 

CONTINUE 

FCRCES 

00472 

c 

DC  CF  LOOP  ON  NU»«ER  OF  PU^CRAB 

FCRCES 

00473 

c 

FCRCES 

00474 

c 

SET  UP  TO  VRITE  RESULTS  ON  TAPE 

FCRCES 

00475 

CALL  ROINIT 

FCRCES 

00476 

I  TYPE  =  THCCNPLEX 

FCRCES 

00477 

FARM(l)  s  ROA. 

FORCES 

004  78 

PARM(2)  =  Bt 

FORCES 

004  7-. 
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PARM<3>  =  XNACH 
C 

C  IP  THIS  IS  THE  FIRST  WEIGHT  INC  FUNCTION,  IT  MAY  BE  NECESSARY 

C  TO  W<ITE  AM5/CR  PRINT  BOX  LIFTS,  ETC 

IF  (.NOT.  BLACED)  CO  TO  600 
1F(M4.NE.1)  CO  TO  600 
C 

IF  (.NOT.  PRBU  CO  TO  570 
C  PRINT  BO*  LIFTS 

TITL(l)  =  AH  WING 
TITLC2)  =  IOHBOX  uIFTS 
TITLCJ)  =  2H 

IFCCOR-AN)  TITL(1)  =  10HWING/TAIL 

CALL  PRNTBL<TITL.JVP,B)0.IFT,l,Wi»6,KfBW,IFNTRM> 

IFONSURF.EB.l  .05.  COPLAN)  CO  TO  570 
TITLU)  =  AH  TAIL 

CALL  fRNTBL(TITL.JVP,Sn.IFT,lXBUT,MXBT,KWBT,IPNTRM(l,I<MAP*l)  > 
570  CCNTINJE 
C 

IF  <.N0r.<KDCP)  CO  TO  572 
C 

c  print  pressure  differential 

TITL01 )  =  AH  WING 

TITLC2)  =  1  OH  PR  ESS.  Cl 

TITLO)  =  10HFPERENCE 

IF(COFLAK)  TITL(l)  =  lOHWING/TAIL 

CALL  TRNT3L(TITL.  JVP.CELCP.1.N50W5,  HTBW,  l PNTRM) 

IF  (*6URF.EB.l  .CR.  CCftAN)  CO  TO  572 
TITLd)  s  AH  TAIL 

CALL  TRNTBL(TITL,JVP,CaCP.IXBUT,MX8T,MfBT,IPNmM(;.ICVLAP»l)  ) 

572  CCNTINJE 
C 

IF(.NOT.  (WTBL.CR .PRSL) )  CO  TO  600 


C 

0* 

C 


EXPAND  BOX  LIFTS  FCR  W5 1 TIP*  ON  TAPE.  WATETP  FCRMAT  CH.Y 


IF  (MARIT)  W5ITE  (NT6.9999) 

C  INITIALIZE  COUNTERS  FCR  PASSING  CWER  ARRAY  BACKWARDS 

C  URL  =  CURRENT  LOCATION  IN  INPUT  (COWESSED)  ARRAY 

C  14  *  CURRENT  LOCATION  IN  OUTPUT  (EXPAfCED)  ARRAY 

C  IJFJT  s  FIRST  LOCATION  FCR  CURRENT  ROW  IN  INPUT  ARRAY 

C  IJPRV  *  FIRST  LOCATION  FCR  DEVIOUS  ROW  IN  INPUT  ARRAY 


now  *  hxs 

IJFST  s  IPNTRN(1,MX8) 

LOCFST  *  IPNTRH(2,MXB> 

IJ»RV  <  IPNTRMd ,MX®»1) 

I4KL  «  IJPRV 

I J  •  *eOKES  -  MVS  ♦  IJRRV-IJFST  ♦  LOCFST 
CO  STS  |  «  l,t«OttS 
MF(I)  «  CO..O.) 

STS  CONTINUE 


LOOP  BACK  HOC  ON  RCkft,  AM)  ON  CHORDS  WITHIN  A  ROM 
SAC  CONTINUE 
14  «  14  -  I 
I4KL  «  I4KL  -  t 


FORCES  00480 
FORCES  00481 
FORCES  00482 
FORCES  00483 
FORCES  00484 
FORCES  00485 
FORCES  00486 
FORCES  0048? 
FORCES  00488 
FORCES  00489 
FORCES  00490 
FORCES  00491 
FORCES  00492 
FORCES  00493 
FORCES  00494 
FORCES  00495 
FORCES  00496 
FORCES  00497 
FORCES  00498 
FORCES  00499 
FORCES  00500 
FORCES  00501 
FORCES  00502 
FORCES  00503 
FORCES  00504 
FORCES  00505 
FORCES  00506 
FORCES  0050? 
FORCES  00508 
FORCES  00509 
FORCES  00510 
FORCES  00511 
FORCES  00512 
FORCES  00513 
FORCES  00514 
FORCES  00515 
FORCES  00516 
FORCES  0051? 
FORCES  00518 
FORCES  00519 
FORCES  00520 
FORCES  00521 
FORCES  00522 
FORCES  00523 
FORCES  00524 
FORCES  00523 
FORCES  00326 
FORCES  0052? 
FORCES  00528 
FORCES  00529 
FORCES  00530 
FORCES  00531 
FORCES  00532 
FORCES  00533 
FORCES  00534 
FORCES  00535 
FORCES  00538 
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BL  =  BxunrujM.) 

fcrces 

0053T 

B*-IFT(IJKL>  =  <0.,0.) 

fcrces 

00538 

RVeF(IJ)=  BL 

FCRCES 

00S39 

IF  (!  JKL  .CT.  IJFST)  CO  TO  580 

FCRCES 

0Q54Q 

c 

6>C  CF  LOOP  ON  CHORDS  WITHIN  ONE  ROW.  STEP  TO  NEXT  ROW 

FCRCES 

00541 

IJPRV  =  IJFST 

FCRCES 

00542 

LOCPV  =  LOCUST 

FCRCES 

00543 

c 

LOOP  BACK  HERE  ON  EMPTY  ROWS  (COPLANAR  CASE) 

FCRCES 

00544 

582  CONTINUE 

fcrces 

00545 

IROW  =  IROW  -  1 

FCRCES 

00546 

IJ  =  IJ  -  MT8 

FCRCES 

00547 

c 

DETEKMITC  WEWER  DOC  - 

FCRCES 

00548 

IF  <IROW  .EB.  0)  CO  TO  584 

FCRCES 

00549 

c 

IS  THE  ROW  EMPTY  - 

FCRCES 

00550 

IF  (IPNTKMd  .IROW)  .EB.  IJfRV)  CO  TO  582 

FORCES 

00551 

IJFST  =  IPNTRMd  i  IROW) 

FCRCES 

00552 

LOCFST  =  I PNTRMI2  >  IROW) 

FCRCES 

00553 

IJ  =  IJ  -  LOCPV  +  I JPRV-I JFST  ♦  LOCFST 

FCRCES 

00554 

CO  TO  580 

FCRCES 

00555 

c 

r< 

END  OF  LOOP  ON  ROW . 

FCRCES 

g verge 

00556 

V.* 

rQKCtS 

c 

FCRCES 

00558 

584  CONTINUE 

FCRCES 

00559 

c 

ARE  THE  SECTION  LIFTS  TO  BE  PRINTED  CR  WITTEN  - 

FCRCES 

00560 

1F(.NOT.  fRSL)  CO  TO  595 

FCRCES 

00561 

c 

CCHFUTE  SECTION  LIFTS 

fcrces 

00562 

TUFT  =  <0.,0.) 

FCRCES 

00563 

TLIFT1  =  (D.,0.) 

FCRCES 

00564 

TLIFT2  =  <0.,0.) 

fcrces 

00565 

DO  590  JCCL  =  l.MTB 

FCRCES 

00566 

F 

II 

a 

o 

FCRCE5 

00567 

BL2  =  (D.,0.) 

FCRCES 

00568 

IROW  =  0 

FCRCES 

00569 

D0  58T  IJ  =  JCa.feoxES.MYB 

FCRCES 

00570 

IROW  =  IROW  ♦  1 

FCRCES 

00571 

IF(IROW.CT.TEn.OC(JCCU)  CO  TO  586 

FCRCES 

00572 

BL  =  BL  ♦  RWF(IJ) 

FCRCES 

00573 

CO  TO  58T 

FCRCES 

00574 

586  BL2  =  BL2  ♦  RWF(IJ) 

FCRCE5 

0057!; 

58 T  CONTI MJE 

FCRCES 

00576 

tufti  =  tlifti  ♦  BL 

FCRCES 

00577 

TLIFT2  =  TUFT2  ♦  BL2 

fcrces 

00578 

SLIFT(JCCL*NTBW>  =  BL2 

FCRCES 

00579 

SLIFT(JCa)  =  BL 

FCRCES 

00580 

590  CONTI HJZ 

FCRCES 

00581 

c 

FCRCES 

00582 

IF  (.NOT.  (RSL  )  CO  TO  595 

FCRCES 

00583 

c 

PRINT  SECTION  LIFTS  AK)  TOTAL  LIFT 

FCRCES 

00584 

CAU.  PRNTSL (J VP, SLI FT, TLIFTI  ,TLIFT2,MTBW,HfBT  ) 

FCRCES 

00585 

c 

FCRCES 

00586 

595  CONTINUE 

FCRCES 

00587 

IF(.NOT.PRCN)  CO  TO  599 

BCSFRB 

00023 

DO  596  Isl.NTVPS 

BCSFRB 

00024 

SCCMlMII)  =  SECMCM(I)  %  TWC8ET 

BCSFRB 

00025 

596  CONTINUE 

BCSFRB 

00026 

NCM  -  -JVP 

BCSFRB 

00027 

CALI  PRNTSL  (NCM. SECMCN, TLIFTI  ,  TL  l  FT2 ,  NCBW,  NTB'i ) 

BCSFRB 

00C  A 
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C  BCSFRB 

599  CONTINUE  BCSHtB 

IF  (.NOT.  WTEL)  OO  TO  (00  FORCES 

C  (RITE  BOX  UFTS  ONTO  THE  BINARY  OUTPUT  FILE  FORCES 

l  TYPE  =  THCCHPLEX  FORCES 

n  =  nxb  forces 

x  =  -  m  forces 

N  =  HYB  FORCES 

MXARRY  =  THB«-IFTS  FORCES 

It) (2)  =  1000000PIKVAL  ♦  4 VP  FORCES 

CALL  VRTENXI  NOUTP,  HXVR1T,RA)©CU,  NFS,  NFS.LS,  NPR.LNS,  K,  ID,  FORCES 

1  RVBF,ITYPE,  N,  N,  FARM,  IRR  )  FORCES 

IF  (IRR  .*C.  0)  CO  TO  922  FORCES 

C  FORCES 

COO  CONTINUE  FORCES 

DC  OF  LOOP  ON  VELOCITY  POTENTIALS  FORCES 

forces 

STORE  THE  ROW  OF  GENERALIZED  AIRFORCES  INTO  THE  FULL  MATRIX  FORCES 

14  s  NM  FORCES 

DO  «20  JVP  =  l.NVPS  FORCES 

CENAF(IJ)  =  AFRGW(JVP)  *TWCBET  FORCES 

GPAFC(IJ)  =  BS3BET  *  REAL(GCNAF(I  J)>  FCRCES 

cpfafc(ij)  =  o.  forces 

IF0WVL.NC.O.)  GPPAFC(IJ)  =  BKS4BT  *  AINMG(GENAF(I J) )  FORCES 

IJ  =  14  ♦  WOKS  FORCES 

CEO  CONTINUE  FCRCES 

CSO  CONTINUE  FORCES 

’’CRCES 
FORCES 

IF(.NOT.WTGNAF)  CO  TO  670  FORCES 

K  =  NODES  FORCES 

M  =  NODES  FCRCES 

n  =  nodes  forces 

ID(2>  =  IKVAL  FCRCES 

CALL  VRTEMX(  NCUTP,  HXVRIT.RANCOU,  NES.NMS.LS,  NR.LWS,  R.  ID,  FORCES 

1  CENAF,  I  TYPE,  N,N,  FARM,  IRR)  FORCES 

IF  (IRR  .TC.  0)  CO  TO  928  FORCES 

c  forces 

C  ARE  THE  FCRCES  TO  BE  PRINTED  -  FORCES 

*70  CONTINUE  FORCES 

IF  (.NOT.  PRGNAF)  CO  TO  TOO  FORCES 

C  FORCES 

CALL  PRNTAF (CENAF, PR CNAC, CPAFC, CPPAFC)  FORCES 

TOO  CONTINUE  FORCES 

C  FORCES 

REWIND  MOCESC  FCRCES 

NOPCE  =  1  FORCES 

750  CONTINUE  FORCES 

C  FCRCES 

RETURN  FCRCES 

C  FCRCES 

C  DIAGNOSTICS  -  ALL  CALL  FLUSH  FORCES 

C  FCRCES 

C  READING  FROM  SCRATCH  FILE  FCRCES 

*010  CONTINUE  FORCES 

(RITE  (NT6.9I00)  ICE06C  FORCES 

CO  TO  950  FCRCES 


00029 

00030 

00588 

00589 

00590 

00591 

00592 

00593 

00594 

00595 

00596 

00597 

00598 

00599 

00600 

00601 

00602 

00603 

00604 

00605 

00606 

00607 

00608 

00609 

00610 

00611 

00612 

00613 

00614 

00615 

00616 

00617 

00618 

00619 

00620 

00621 

00622 

00623 

00624 

00625 

00626 

00627 

00628 

00629 

00630 

00631 

00632 

00633 

00634 

00635 

00636 

00637 

00638 

00639 

00640 

00641 

00643 
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6020  CONTINUE 

FCRCES 

00643 

MUTE  (NT6.9I20)  MCCESC 

FORCES 

00644 

CO  TO  S50 

FCRCES 

00645 

®J0  CONTINUE 

FCRCES 

00646 

MUTE  (NT6,9180)  IVPSC 

FCRCES 

00647 

CO  TO  950 

FORCES 

00648 

c 

FCRCES 

00649 

€040  CONTINUE 

FCRCES 

00650 

MUTE  (NTS, 9140)  ITSLSC 

F(RCES 

00651 

CO  TO  950 

FCRCES 

00652 

C 

FCRCES 

00653 

c  MUTING  X  THE  OUTfVT  TAPE 

FCRCES 

00654 

922  CCKTINUE 

FCRCES 

00655 

MUTE  (NT6.9220)  NOUTP 

FORCES 

00656 

CO  TO  952 

FCRCES 

00657 

928  CONTINUE 

FCRCES 

00658 

MUTE  <NT6,9280)  NOUTP 

FCRCES 

00659 

CO  TO  952 

FCRCES 

00660 

c  INCORRECT  DIMET6I06  READ 

FCRCES 

00661 

930  CENTIME 

FCRCES 

00662 

I  =  1 

FCRCES 

00663 

CO  TO  932 

FORCES 

00664 

931  I  =  2 

FCRCES 

00665 

932  MUTE  (NTS.930G)  I 

FCRCES 

00666 

IF(MJREAO)  CO  TO  960 

FCRCES 

00667 

CO  TO  962 

FCRCES 

00668 

C  ERROR  DETECT  EC  READING  A  MATRIX 

FCRCES 

00669 

990  CONTINUE 

FCRCES 

00670 

MUTE  (NT6.950G)  IRR 

forces 

00671 

IF(M«EAC)  CO  TO  960 

forces 

00672 

CO  TO  962 

FORCES 

00673 

C  ERROR  DETECTED  MUTING  A  MATRIX 

FCRCES 

00674 

952  CONTINUE 

FCRCES 

00675 

MUTE  (NT6.9520)  IRR 

FCRCES 

00676 

IF(MXMUT)  GO  TO  990 

FCRCES 

00677 

CO  TO  962 

FCRCES 

00678 

C  ►WTKIX  DESCRIPTION 

FCRCES 

00679 

960  CCKTINUE 

FCRCES 

00680 

MUTE  (NT6.9600)  (ID (I ) ,  1=1 ,10)  ,  (I C(I) ,  1=1 ,10) 

FCRCES 

00681 

MUTE  (NT6.9622)  FARM,  PARK 

FCRCES 

00682 

MUTE  (NT6.96J4)  TAR  , , LRS , LW5 

FCRCES 

X683 

CO  TO  964 

FCRCES 

00684 

962  MUTE  (NT6.9620)  ID(1>,IC'.2) 

FCRCES 

00685 

MUTE  (NT6.9622)  FARM,  PAR* 

FCRCFS 

00686 

MUTE  (NT6.9624)  TfS.TKS 

FCRCES 

00687 

964  MUTE  (NT6.9S40)  ITTPE.M.N 

FCRCES 

00688 

MUTE  (NT6.9650)  MXARRY 

FCRCES 

00689 

CO  TO  990 

FCRCES 

00690 

« It)  CONTINUE 

FCRCES 

00691 

MUTE  (NTS.9TOO)  IRON,  JCCL 

FCRCES 

00692 

CO  TO  990 

FCRCES 

00693 

C 

FCRCES 

00694 

990  CO  I  HUE 

FCRCES 

00695 

MUTE  (NTS, 9900) 

FCRCES 

00696 

c 

FCRCES 

00697 

CAU  FLUSH  (1) 

FCRCES 

00698 

C 

FCRCES 

00699 
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c  diagnostic  formats 

9100  fcrmatutho***  error  vhile  reading  geometry  scratch  file  ,A10, 

1  4H  ***  ) 

9120  FORMAT (AAHO.'M  ERROR  VHILE  READING  MQCES  SCRATCH  FILE  .A10, 

1  4H  ***  ) 

9140  FORMAT C54H0***  ERROR  VHILE  READING  THICXNCSS  SLOPE  SCRATCH  FILE 
1  A10,  4H  ***  ) 

9190  FORMAT <5lH0«*  ERROR  VHILE  READING  VELOCITY  POTENTIAL  SCRATCH 
1  CH  FILE  ,A10,4H  ***  ) 

DATA  XI FT  /2*  600UXOXICI02003TT7TTB  / 

9220  FORMAT (49H0 ***  ERROR  VHILE  WUTING  BOA  LUTS  CH  OLfTfA/T  TAPE, 12, 

1  4H  ***  ) 

9290  FORMAT (5€H0«*4>  ERROR  VHILE  WAITING  GENERALISED  AIRFORCES  ON  OUTFIT 
1  3H  TAPE,  12, 4H  ***  ) 

9300  FORMAT <1H0,  48H***  MATRIX  READ  ERROR.  THE  M  DIMENSION  SHOULD 

1  4H  IE  .12,  4H  ***) 

9900  FORMAT <1  END  ***  ERROR  CCCE  ,15,  28H  VHILE  READING  THE  FCLLCWIMG 
1  11H  MATRIX  ***  ) 

9320  FORMAT <1  (HO  ***  ERROR  CCCE  ,15,  28H  VHILE  WRITING  THE  FOLLOWING 
t  tlH  MATRIX  ***  > 

9900  FORMAT <  SX.ttMTRIX  ID  =  *,  10A10  /  (20X.10A10)  ) 

9614  FORMAT (  5X.22H MATRIX  IVCETX  (NAME)  =  ,IS,2H  CA10.1H)  / 

1  5X.33HLEVEL  NLACER  READ  (CR  WUTTEN)  =  C2.3H,  (,C2,1H)  ) 

9G20  FORMAT (  SX.4MA1RIX  ID  =  *,  A10,  110  ) 

9622  FORMAT (  SX.UHftRAMETERS,  10EI1.3  /10X,  9H( INTEGER) ,  17,9111) 

9624  FORMAT <  5X.15HFILE  SPACING  =  ,13,  19H,  MATRIX  SPACING  =  ,13  ) 

9640  FCRMATC  5X.4HATRIX  TYPE  -  *,410,  *,  DIMENSIONED  (*I4,*  X*,I4,*)*) 
9650  FORMAT  (  5X,*ARRAY  -  *,  AID) 

9700  FCRNAAT (37H0***  POINTER  ARRAY  EXCEEDED  FOR  BOX  (.  14. IH.I4.5H)  ***) 
9900  FORMAT (49H0***  ERROR  OCCLRRED  DURING  GENERALIZED  AIRFORCES 
1  1TH  CALCULATIONS  ***  > 

9999  FORMAT  (54HQ***  WARNING  -  BOX  LIFTS  CANHOT  BE  VRITTEH  IN 
1  1  CHS  NARK  FORMAT  ***  ) 

C 

EM) 


forces 

00  TOO 

forces 

00701 

FORCES 

007D2 

FORCES 

00703 

fcrces 

00704 

FORCES 

00705 

FCRCES 

00 706 

FCRCES 

00707 

FCRCES 

00706 

FTNX1 

00082 

FCRCES 

00711 

FCRCES 

00712 

FCRCES 

00713 

FCRCES 

00714 

FCRCES 

00715 

fcrces 

00716 

FCRCES 

00717 

FCRCES 

00718 

FCRCES 

00719 

FCRCES 

00720 

FTNX1 

00083 

FCRCES 

00722 

FTNX1 

00084 

FCRCES 

00724 

FCRCES 

00725 

FCRCES 

00726 

FCRCES 

00727 

FCRCES 

00728 

FCRCES 

00729 

FCRCES 

00730 

FCRCES 

00731 

FCRCES 

00732 

FCRCES 

00733 

FCRCES 

00734 

FCRCES 

00735 
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sueRarmc  dcocek<I6cx.lbox,  ia.ja.  il.jl,  si®d,  icoco 

DCCCAF 

00002 

DIMENSION  I BOX (LBOX,  1 )  i  ICCCE(I) 

DCCCAF 

00003 

c 

DCOCAF 

00004 

c 

IBOU  -  ARRAY  CF  BOX  CCCES  IN  PACKED  VCRD  ECU  HAT 

DCOLAF 

00005 

c 

LB  OX  -  ROW  DIHENSICN  OF  BOX  CCCES  ARRAY 

DCOCAF 

00006 

c 

IA  -  I-TH  I>CEX  OF  FIRST  CCCE  TO  RETRIEVE 

DCOCAF 

00007 

c 

JA  -  J-TH  ItCEX  OF  FIRST  CCCE  TO  RETRIEVE 

DCOCAF 

ooooe 

c 

IL  -  LAST  BOX  CCCE  CN  THE  JA-TH  OH  CRD  TO  RETRIEVE 

DCCCAF 

00009 

c 

JL  -  LAST  BOX  ON  THE  IA-TH  ROW  TO  RETRIEVE 

DCCCAF 

00010 

c 

SVJBD  -  .T.,  SUBDIVIDED  BOX  COCES  DESIRED,  .F.  SUBDIVIDED. 

DCCCAF 

00011 

c 

ICOCE  -  ARRAY  INTO  VHICH  BOX  CCCE  WILL  BE  STCRED. 

DCCCAF 

00012 

c 

DCOCAF 

00013 

c 

CO*€NT  CN  USAGE 

DCCCAF 

00014 

c 

BOX  CCCES  CAN  BE  RETRIEVED  FCR  OC  BOX,  A  ROW  CR  FART 

OF 

DCCCAF 

00015 

c 

A  RCW,  OR  A  CaUMN  CR  FART  CF  A  CaUMN.  A  ROW  AKC  COLUMN  CAN 

DCOCAF 

00016 

c 

NOT  BE  RETRIEVED  AT  THE  SAME  TIME.  IF  CH.Y  1  BOX  IS  DESIRED 

DCCCAF 

00017 

c 

SET  IL  =  IA  AND  JL  =  JA.  IF  BOTH  IL  .NE.  IA  AND  JL 

.NE. 

DCCCAF 

00018 

c 

JA,  ONE  ROW  WILL  BE  RETURNED,  IL  BEING  IGNCRED. 

DCCCAF 

00019 

c 

DCCCAF 

00020 

COWCN  /CCCKTY/  COPLAN,  NSUBCV,  XSUBDV,  NSUBD2 ,  NSUBCN,  NSLRF, 

GECMTY 

00002 

1  B1  >B1  BETA,  BIS,  B1BTAS,VLAX,WLA2,  PSIW, 

GECMTY 

00003 

2  MXBW.  MX8BW,KfBW,  WfBBW,  MXBSW,  Mf  BSW,  WBBSW, 

GEOMTY 

00004 

3  IXBW.XCENTR 

GECMTY 

00005 

LOGICAL  COPLAN 

GEOMTY 

00006 

LOGICAL  SUED 

DCOCAF 

00022 

INTEGER  SHIFT 

DCCCAF 

00023 

DATA  fCVKD  /20/ 

DCCCAF 

00024 

MASK  =  T 

DCCCAF 

00025 

IB  -  t 

DCCCAF 

00026 

IF  (SUED)  GO  TO  50 

DCCCAF 

00027 

I  =  ffcUBCV  *  (IA-1 )  ♦  IXBW 

DCCCAF 

00028 

J  =  NSUBCV  *  (JA-1 )  ♦  NSU6CN 

DCCCAF 

00029 

ISKIP  =  NSUBCV 

DCCCAF 

00030 

IEM)  -  NSUBCV  *  HIL-l )  ♦  IXBW 

DCCCAF 

00031 

JE»C  =  NSUBCV  *  (JL-1)  ♦  N6UBCN 

DCCCAF 

00032 

GO  TO  eo 

DCCCAF 

00033 

30  CONTINUE 

DCCCAF 

00034 

I  =  IA 

DCCCAF 

0CO35 

J  =  JA 

DCCCAF 

00036 

ISKIP  =  1 

DCCCAF 

OOG37 

IOC  =  IL 

DCCCAF 

00038 

JEND  -  JL 

DCCCAF 

00039 

BO  CCNTIMJE 

DCCCAF 

00040 

IF  (JL  .EO.  JA)  GO  TO  1100 

DCCCA1' 

00041 

c 

DCCCAF 

00042 

c 

FROCRAM  Wlu.  RETRIEVE  NI  BOXES  PR  CM  ROW  I 

DCCCAF 

00043 

100  CCHTIMUe 

DCCCAF 

00044 

DO  1000  JJ  =  J.JENC, ISKIP 

DCCCAF 

0004  5 

JSB  = (JJ-1 )  /N5VRC  «•  1 

DCCCAF 

00046 

IJWCRO  =  IBOX(I.JSB) 

DCCCAF 

00047 

JB  =  U6VRD  -  MCC<JJ,NCW<B)  )  *  3 

DCOCAF 

00040 

iF(jB.EO.eO)  JB  =  0 

DCCCAF 

00049 

c 

JB  =  NUKJER  CF  BITS  TO  SHIFT  LEFT. 

DCCOAF 

00050 

I  JMASKs  SHI  FT  (MASK,  JB) 

DCOCAF 

00051 

IJCUCf  S  I  JWCRC .  AND  .  I  JHASK 

DCOCAF 

00052 

HJB  s  -JB 

DCCCAF 

009  5 

ICCCE(IB)  s  SHIFT  (I  JCOCC.NJB) 

DCCCAF 

00  jM 

B214 


IB  =  IB  ♦  1 

DCOCAF 

00055 

1000  CONTINUE 

DCOCAF 

0005G 

CO  TO  3000 

DCOCAF 

0005? 

c 

DCOCAF 

00056 

c  PROGRAM  WILL  RETRIEVE  NJ  BOXES  FROM  CHCRD  J 

DCOCAF 

00059 

1100  CCNTIMJE 

DCOCAF 

000 GO 

JSB  =  <J-1)/*CW«B  ♦  1 

DCOCAF 

00061 

JB  =  <»CWtD  -  MQCU.fCVRB)  )  *  3 

DCOCAF 

00062 

IFOB.Ea.GO)  JB  =  0 

DCOCAF 

00063 

IJHASK  a  SHIFT  (HASH,  JB) 

DCOCAF 

00064 

NIB  =  -JB 

DCOCAF 

00065 

DO  2000  II  =  t.IDC.lSiaP 

DCOCAF 

00066 

I J  WORD  =  IBQK(II.JSB) 

DCOCAF 

00067 

IJCCCE  *  I  JVCRC.AfC.I  JMASK 

DCOCAF 

00066 

ICQCE(IB)  =  SHI  FT  (IJCCCE.  NJB) 

DCOCAF 

00069 

IB  =  IB  ♦  1 

DCOCAF 

00070 

3000  CONTINUE 

DCOCAF 

00071 

C 

DCOCAF 

00072 

3000  CONTINUE 

DCOCAF 

00073 

RETURN 

DCOCAF 

00074 

DO 

DCOCAF 

00075 
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SUBROUTI  rr.  PRNTBL  <T  I TU  .  I  MOCE .  ARRAY  ,  1  XB  ,  M*B  ,  MYB ,  1  PNTRM) 

PRNTBL 

00002 

c 

PRNTBL 

00003 

c 

PRINTS  BOX  LIFTS,  USES  /RVfiUFF/  Fr*  INTERMEDIATE  SCRATCH 

PRNTBL 

00004 

c 

IMOCE  -  MCCE  SHAPE  HUM  OCR 

PRNTBL 

00005 

c 

ARRAY  -  ARRAY  TO  BE  PRINTED 

PRNTBL 

00006 

c 

I  PNTRM  -  POINTER  ARRAY  FCR  RCV6  IN  -ARRAY - 

PRNTBL 

00007 

c 

NPNTRS  -  NUMBER  CF  POIN'ERS 

PRNTBL 

00008 

c 

PRNTBL 

00009 

COMPLEX  ARRAY  <i) 

PRNTBL 

00010 

DIMENSION  TITL  (3) 

PRNTBL 

00011 

DIMENSION  IPNTRM<2,50) 

PRNTBL 

OGGI  2 

c 

B5NTBL 

00013 

CCM4CN  /CCNTRL/  PREVEX, CMACH,  TITLEIB),  PRVGECM,  PRVMCCE,  DIHW,  DIHT, 

CONTRL 

00002 

1  DEFAULT 

CONTRL 

00003 

LOGICAL  PRVGECM, PRVMCCE, DIHW.DIHT, DEFAULT 

CONTRL 

00004 

COMMON  /PRCBLH'  XMACH.NKXES,  NT  SLOP,  NKVALS,  SMOOTH,  fCEG.CRDFIT, 

PRCBLM 

00002 

1  EXAIC.SUBDV.PLYWXC 

*RC8LM 

00003 

LOGICAL  SMOOTH  .CRDHT.EXA  I  C.SUBDV,  PVfWCCC 

PRCBLM 

00004 

COMMON  /KVAL  /  IKVAL,  WVAL  (20)  ,  WSI20) 

KVAL 

00002 

CONQN  /FILES  /  NT5,NT6,INTAPE,IKFSP,NPLAtC,NSPAIC,NCUTP, 

FILES 

00002 

1  IOUFSP,  MCCESC 1 1 VPSC,  I GEC6C ,  I WTFSC,  IAICSC 

files 

00003 

c 

PRNTBL 

00019 

INjEGER  page 

PRNTBL 

00020 

DIMENSION  SCI )  ,C(1 ) 

PRNTBL 

00021 

EHUI  VALENCE  (S.BUFF)  ,  (D,BUFF<1251 ) ) 

PRNTBL 

00022 

CCMH.EX  TLIFT 

PRNTBL 

00023 

COMPLEX  TLIFT1.TLIFT2 

PRNTBL 

00024 

CIPCNSICN  PC  12)  ,  I  PNT  (2) 

PRNTBL 

OOC25 

BBUIVALENCE  (IPMT,  TLIFT) 

PRNTBL 

00027 

CCMOI  /RVBUFF/  BFC'XE.IBFCNT,  BUFF (3280) 

RVBUFF 

00002 

DATA  PC  /  1  OH  PAGE  CONTI  .4HNJEE  / 

FTNX1 

00086 

DATA  BLA*K  /1H  / 

PRNTBL 

OOC..S 

DATA  XI NIT  /  -t.O  / 

PRNTBL 

00029 

DATA  LINEMX  /50  / 

PRNTBL 

00G30 

c 

PRNTBL 

00031 

c 

PRNTBL 

00032 

*VL  =  WVAL(IXVAL) 

PRNTBL 

00033 

IF<ms<IRVAL)  .TC.XINIT)  WVL  =  WSIIKVAU 

PRNTBL 

00034 

PAGE  =  0 

PRNTBL 

00035 

N  =1 

PRNTBL 

00036 

M  =4 

PRNTBL 

00037 

IF(M.GT.MYB)  M  =  MrB 

PRNTBL 

00038 

c 

PRNTBL 

00039 

100  LINE  -  100 

PRNTBL 

00040 

200  DO  1400  I=IXB,MXB 

PRNTBL 

00041 

DO  XX)  J-N,M 

PRNTBL 

00042 

S(J)  =  0.0 

PRNTBL 

00043 

D(J)  =  0.0 

PRNTBL 

00044 

300  CONTINUE 

PRNTBL 

00045 

IF(U)C.LE.50)  CO  TO  900 

PRNTBL 

00046 

PACE  r  PACE  ♦  1 

PRNTBL 

00047 

LINE  =  4 

PRNTBL 

00048 

WIITE  (NTS, 9001 )  TITLE, TITL, XMACH.WVL.IMXE 

PRNTBL 

00049 

IF(PACE.Ea.l)  CO  TO  TOO 

PRNTBL 

00050 

WRITE <NT6, 900 5)  PC 

PRNTBL 

00051 

CO  TO  BOO 

PRNTBL 

00052 

TOO  WiITE(NT6,9005) 

PRNTBL 

00053 
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MO  CONTINUE 

WdTE<NT6,6006)  (BLANt,  J  ,  JrN.M) 

VRITE(NT6,6007>  (BLAU,  J=N,N) 

C 

MO  CONTINUE 

J5  =  IPNTRM(2,I) 

IFtJS.LE.O)  CO  TO  1400 
IOX  S  IPNTRMd  1 1) 

JEs  IPNTRMd »!♦!)  -  IOX  ♦  JS-f 

IF(JE.EQ.O)  GO  TO  1400 

DO  1000  JsJS.JE 

S(J)  =  REAL  (ARRAY  (I  CX) ) 

DO)  *  AINACtARRAY OCX) ) 

1DX  =  IOX  ♦  1 
1000  CONTINUE 

DO  1200  J  =N,M 
IF(SO))  1300.1100,1300 
1100  CONTINUE 

IF(DO))  1300,1200.1300 
1200  CCNTIMLC 
CO  TO  1400 

1300  VRITE(NT6,9013)  I ,  (S(J)  ,D(J) ,  J=N,N> 

LINE  =  LITE  ♦  1 
1400  CONTINUE 
C 

M  s  M»4 
N  a  N*-4 

IF(N.CT.MYB)  Co  TO  1300 
IF(M.CT.NTB)  H  s  NTB 
IFtLINE.CT.45)  CO  TO  100 
VftITE<NT6,6006>  (BLANt ,  J ,  J=N,H) 

W»ITE<NT6,e007)  (BLANt,  J=N,M) 

UPC  =  LI  PC* 3 
CO  TO  200 
1300  CONTINUE 

RETURN 

S001  F<RMATdH1.20X,8A10,/S0X,3A10,/  46X.7HI  HACH  F5.3.5X.10HRED.PRBB. 

1  «c*,FB.S,  *  )•  /52X,«NOCE  SHAPE*,  13  ) 

9005  F<RHAT<44X,42dH-),2QX,A10,A4  ) 

«0*  FORMAT (4HDROW,  A1 , 14X, SMOPCRC,  13. 3(A1 ,22X, 3HOPCRC,  13) ) 

M07  FORMAT <3X,  4 U1,9X,4HREAL,BX,9HI MACINARY)  ) 

9013  FORMAT (14,806.6) 

DC 


PRNTBL  00054 
PRNTBL  00055 
PRNTBL  00036 
PRNTBL  0005? 
PRNTBL  00058 
PRNTBL  00059 
HRNTBL  00060 
PRNTBL  00061 
PRNTBL  00062 
PRNTBL  00063 
PRNTBL  00064 
PRNTBL  00065 
PRNTBL  00066 
PRNTBL  00067 
PRNTBL  00066 
PRNTBL  00069 
PRNTBL  00070 
PRNTBL  00071 
PRNTBL  00072 
PRNTBL  00073 
PRNTBL  00074 
PRNTBL  00075 
PRNTBL  00076 
PRNTBL  00077 
PRNTBL  00078 
PRNTBL  00079 
PRNTBL  00080 
PRNTBL  00081 
PRNTBL  00082 
PRNTBL  00083 
PRNTBL  00084 
PRNTBL  00085 
PRNTBL  00086 
PRNTBL  00087 
PRNTBL  00088 
PRNTBL  00089 
FRNTEL  00090 
PRNTBL  00091 
PRNTBL  00092 
PRNTBL  00093 
PRNTBL  0CO94 
PRNTBL  00095 
PRNTBL  00096 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 


c 


SUBROUTINE  PRNT$L(IMCCE,SLIFT,TLIFTl.TLlFT2,MrBW.MrDT)  PRNTBL 

PRNTBL 

*!INT3  THE  SECTION  LIFTS  AW  TOTAL  LIFTS  PRNTBL 

PRNTBL 

IMCCE  -  MCCE  SHAPE  NUWER  WINTBL 

SUFT  -  SECTION  LIFT  1RRAY  PRNTBL 

TLIFT1  -  WING  TOTAL  LIFT  PRNTBL 

TLIFT2  -  TAIL  TOTAL  LIFT  PRNTBL 

bcsfrb 


IF  I  MCCE  IS  WCATIVE  THE  TROCRAM  WILL  OUTPUT  SECTION  MOMENTS  BCSFRB 

BCSFRB 

PRNTBL 


COMMON  /PRCJ5LM/  XMACH, FMCCES, NTSLOP,  FKVALS , SMOOTH ,  WEG.CRBFIT ,  FRC8LM 

1  EXAIC.SceCV.PLYWOCC  PRCBLM 

LOGICAL  SMOOTH,  CRCF1  T.EXAIC ,  SUBCV,  PLYWOOC  PRC8LM 

COMMON  /CCNTRL/  PREVEX, CMACH,  TITLE (8) ,  FRVGECM,  FRVMCCE,  CtHW,  DIHT,  CCNTRL 

l  DEFAULT  CONTRL 

LOGICAL  PRVGECM.PRVHCCE.CIHW.CIHT,  DEFAULT  CCNTRL 

COMMON  /KVAL  /  IKVAL ,  XXVAL  (20)  ,  )fcS<20>  KVAL 

CCARWN  /FILES  /  NTS, NT6.  INTAPE,  INFSP,Na>IC,WFAtC,NC)UTP,  FILES 

1  tOLffSP.MCCESC,  I VPSC ,  I GE06C, IWTFSC,  IAICSC  FILES 

PRNTBL 

COMPLEX  SLIFTU)  PRNTBL 

COMPLEX  TLIFT1.TLIFT2.TLI  Ft  PRNTBL 

LOGICAL  PRCM  BCSFRB 

DVTA  BLANC/1H  /  PRNTBL 

DATA  XINIT  /  -1.0  /  PRNTBL 

PRNTBL 

IF  UMODE.LT .0)  GO  TO  1GG  BCSFRB 

FRCM  =  .FALSE.  BCSFRB 

GO  TO  200  BCSFRB 

100  CONTINUE  BCSFRB 

PRCM  =  .TRUE.  BCSFRB 

IMCCE  =  -IMCCE  BCSFRB 

200  CONTI MUE  BCSFRB 

PRNTBL 

*VL  s  R3VAL  (IKVAL)  PRNTBL 

IFO*S(lKVAU  .NE.XIWT)  )*VL  =  WS(lKVAL)  PRNTBL 

IF«pRCM)  GO  TO  300  BCSFRB 

WUTE  (NT6.6O10)  XMACH.'-rVL.  IMCCE  PRNTBL 

CO  TO  400  BCSFRB 

300  CONTI  MUE  BCSFRB 

VRITE  (NT6.9010)  XMACH.I^VL,  IMCCE  BCSFRB 

400  CONTINUE  BCSFRB 

VR  J  TE  (NT6.6008)  PRNTBL 

VRITE  (NTS, €005)  PRNTBL 

VRITE  (NTS, 6020)  PRNTBL 

VRITE  (NTS, 600 T)  BLAF*  ,BLAF* ,BLAN( ,BUN(  FRNTBL 

DO  600  I  =  1,MTBW,4  PRNTBL 

II  =  I  ♦  3  IRNTBL 

IF  <U  , GT.  MY8W)  II  s  WBW  PRNTBL 

VRITE  (NT6.6030)  I ,  (SLlFT  (I  J) ,  I  J=I ,  1 1 )  PRNTBL 

(DC  CC»n;iue  PRNTBL 

IF  (PRCM)  GO  TO  650  BCSFRB 

VRITF  (NTS, 6023)  TLIFT1  PRNTBL 

( P  (Nrg  T  .  FO  .0)  GO  TO  900  BCSFRB 

FRNTBL 


00097 
00098 
00099 
00100 
00101 
00102 
00103 
00104 
00031 
00032 
00033 
00105 
00002 
00003 
Ol  104 
00002 
00003 
00004 
00002 
00002 
00003 
00109 
00110 
00111 
00035 
00112 
00113 
00114 
00036 
00037 
00038 
00039 
00040 
00041 
00042 
00115 
00116 
00117 
0004J 
001  IB 
00044 

00045 
00046 
00047 
00119 
00120 
00121 
00122 
00123 
00124 
0G123 
00126 
00127 
00048 
00128 
00049 
G012  > 
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MUTE  (NTS, 6009) 

CO  TO  «73 
630  CONTINUE 

IF(MTBT.£9.0)  CO  TO  600 
MUTE(NT6,9009> 

673  CONTINUE 

MUTE  (NT6.6020) 

MUTE  (NTS, 6007)  BLAN(,BLAM(,BLAN(,BLAM< 
DO  TOO  Isl.MTBT.4 
II  a  t  ♦  3 

IF  (II  .CT.  M7BT)  !1  =  MfBT 
I*  »  I  ♦  MYBW 
I 12  *  II  ♦  MTBW 

MUTE  (NTS, 6030)  I ,  IKIFTU  J)  ,t  J=I2,II2> 
TOO  CONTINUE 
C 

IFCPRCM)  CO  TO  800 
MUTE  (NTS, 6024)  TLIFT2 
TV  I  FT  *  TUFT1  ♦  TLIFT2 
MUTE  (NTS,  6025)  TV  I  FT 
tOO  CONTINUE 
RETURN 


6003  FCRMAT<44X,32(1H-),30X,A10,A4> 

•007  F<RMAT<3X,  4  (A1 ,9X,4HREAL,8X,9HIKA6INART  )  > 

6000  FORMAT  ( 38  X.AWING*  ) 

6009  FCRMATdHO,//  33X,  ^SECTION  LIFTS*  /  58X,*TAtL*,/  44X,32(lH->  /  ) 
•DIO  FCRMATdHO. S2X,  lAhSECTION  LIFTS  /44X,*t  MAW  *,FS.3,5X, 

1  (RED.  FREQ.  =*  PB.5,*  )«  /  32X.4M0CE  SHAPE*, 13) 

•020  FORMAT  (6MOOKRD) 

•023  FCRMATdHO, 44 X,*  TOTAL  LIFT  -  WINS  *  /  IK)  40X.2E16.8  ) 

•024  FCRMAT (1H0 ,44X, *  TOTAL  LIFT  -  TAIL  *  /  1HD  40X.2E16.8  ) 

6023  FCRMAT (1H0.33X,*  TOTAL  LIFT  */  1H0,40X,2E16.8  ) 

6030  FCRMAT (14, 8E1S.8) 

9009  FCRMATdHO//  4SX, (SECTIONAL  MOMENT  C0EFFIC1ENTS*/58X,*TAIL*/ 
t  44X,  32dH->  /  ) 

•010  FCRMATdHO////, ASX, (SECTIONAL  MOMENT  CCEFFICIENTS*/44X,*(**CH  *, 
1  F3.3,3X,(*ED.  PRES.  **  F8.5, *  )*  /32X,«  MCCE  SHAPE*, IS) 

CM) 


PRNTK 

00130 

BCSFRB 

00050 

BCSPRB 
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BCSFRB 

00052 

BCSPRB 

00033 

BCSPRB 

00034 

PRNTBL 
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PRNTK 
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PRNTBL 
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PRNTBL 
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PRNTBL 
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PRNTBL 

001 36 

PRNTBL 

00137 

PRNTBL 
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PRNTK 

0U139 

PRNTK 

00140 

BCSPRB 

00053 

PRNTK 

00141 

PRNTK 
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PRNTK 

00143 

BCSPRB 

00056 

PRNTK 

00144 

PRNTK 

0014S 

PRNTK 

00146 

PRNTK 

00147 

PRNTK 

00148 

PRNTK 

00149 

PRNTBL 

00150 

PRNTBL 

00151 

PRNTK 

00152 

PRNTK 

00153 

PRNTK 

00154 

PRNTK 

00155 

PRNTK 

00156 

PRNTK 

00157 

BCSPRB 

00057 

BCSFRB 

00  * 

BCSPRB 

00059 

BCSPRB 

00060 

PRNTK 

00158 
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SUGROUTIPC  PRNTAF(AKRAY,PRGPMC,CFAFC,GPPAFC>  PRNTAF 

C  PRINTS  COMPLEX  GENERALIZED  AtfiFCRCES,  FROM  COMPACT  FORTRAN  PRNTAF 

C  STCRACC  PRNTAF 

C  PRNTAF 

C  ARRAY  -  ARRAY  CF  GCPCRALIZED  AIR  FORCES  PRNTAF 

C  PRCNAC  -  LOGICAL  FLAG  FOR  PRINT  OPTION  H5NTAF 

C  CPAFt  -  A  CARD  GENERALIZED  AERCCYNAMIC  COEFFICIENT  PRNTAF 

C  GPPAFC  -  A  CARD  GENERALIZED  AERCCYNAMIC  COEFFICIENT  PRNTAF 

C  PRNTAF 

COMPLEX  ARRAY  (1)  PRNTAF 

DIME  >6 1  CM  GPAFC<1),  GPPAFC  (1)  PRNTAF 

LOGICAL  FRGNAC  PRNTAF 

C  PRNTAF 

DIMENSION  PC (2)  PRNTAF 

COMON  /FRC25LK/  »4ACH,  P**CCES,NTSLCP,N(VALS, SMOOTH, NDEG.CRDrIT,  PRCSLM 

1  EXAIC,SUBCV,H.YWOCC  prcblm 

LOGICAL  SMOOTH,  CRDFIT.EXAIC.SUBCV.  FLYWXC  PRC8LM 

CO840N  /KVAL  /  IKVALi  NAVAL  (20)  ■  WS(20)  KVAL 

COWON  /FILES  /  NT5.NT6,INTA'JE,lAlrSP,hfLAIC,T6PAIC,NaUTP,  HlFS 

1  I0UF5P,MCCE5<‘, !  VPSC,  IGE06C,  IWTFSC,  IAICSC  FILES 

INTEGER  PAGE  PRNTAF 

DATA  PC  /  10HPAGE  CONTI  .4HNUED  /  FTNX1 

DATA  BLANK  /  1H  /  FTNXT 

DATA  XINIT  /  -1.0  /  FTNX1 

*VL  =  KVALdKVAL)  PRNTAF 

IFORS(IKVAL).PC.XINIT)  WVL  =  WS(IKVAL)  PRNTAF 

U*CMX  =  50  PRNTAF 

PACE  =  O  PRNTAF 

J1  =  1  PRNTAF 

JZ  s  4  PRNTAF 

IF  (WXC5  -LT.  J2)  J2  =  KHCCES  PRNTAF 

IJ1  =  1  PRNTAF 

I J2  =  (J2-1)*»MCCE5  ♦  1  PRNTAF 

c  PRNTAF 

100  UPC  =  LI»CMX  ♦  10  PRNTAF 

110  DO  200  I  r  l.MKXES  PRNTAF 

IF  (LINE  .LE.  LINEMX)  CO  TO  1  TO  PRNTAC 

PACE  =  PACE  ♦  1  PRNTAF 

LIKE  r  8  PRNTAF 

MITE  (NTS, €001)  XmCH.^VL  PRNTAF 

if  (page  .EB.  l)  go  to  i®  prntaf 

MITE  (PITS,  6005)  PC  PRNTAF 

GO  TO  180  PRNTAF 

1®  MITE  » NTS, €005)  FRNTAF 

1«0  CONTINUE  PRNTAF 

C  PRNTAF 

MITE  (NTS.SOOS)  (BUM.J,  J=JI,J2)  PRNTAF 

MITE  (NTS, SOOT)  (BUM,  JSJ1.J2)  PRNTAF 

C  PRNTAF 

I  TO  CONTINUE  PRNTAF 

MITE  (MTS,  8010)  I,  (ARRAY  <JJ)  ,IJs  I J1 , 1  J2,PMQCES)  PRNTAF 

UK.  *  LI  PC  ♦  1  PRNTAF 

I  At  *  I  At  ♦  I  PRNTAF 

IU2  s  IJ2  ♦  1  PRNTAF 

ZOO  CONTINUE  PRNTAF 

C  PRNTAF 

j|  :  j|  «  4  PRNTAF 


00002 

00003 

00004 

00005 

00006 

0000? 

00008 

00009 
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00004 

00002 
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00087 
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OOG89 
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00028 

00029 

OOG3G 
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00036 

00037 
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00039 

00040 

00041 

00042 

00043 

00044 

00045 

00046 

00047 

00048 

00049 

00050 

00051 

00052 

00055 

00054 

00055 
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J2  =  J2  ♦  4 

PRNTAF 

00036 

if  <ji  .ct.  pmqces>  co  to  300 

PRNTAF 

0005? 

IF  <J2  .CT.  PMCCES)  J2  =  MtOCQ 

PRNTAF 

00039 

IJl  s  I Jl  ♦  3MMCCES 

PRNTAF 

00039 

I J2  3  IJl  ♦  (J2-J1)  *  PMCCES 

PRNTAF 

00060 

IF  (LIPC  .CT.  LPCHX  -6)  CO  TO  iOO 

PRNTAF 

00061 

MUTE  (NT6,®06>  J  3  J1.J2) 

PRNTAF 

00062 

UPC  s  LI*C*3 

PRNTAF 

00063 

CO  TO  110 

PRNTAF 

00064 

C 

PRNTAF 

00063 

300  CONTINUE 

PRNTAF 

00066 

C 

PRNTAF 

00067 

c  PAINT  THE  CCPCRALlZEt  AERGCVNAHIC  COEFFICIENTS 

PRNTAF 

00069 

C  IF  DESIREE. 

C 

PRNTAF 

PRNTAF 

00069 

00010 

IF(.NOr.RRGNAC)  GO  TO  1400 

PRNTAF 

00071 

pace  3  o 

PRNTAF 

00072 

00  1300  IPR  3  1,2 

PRNTAF 

00073 

Jl  «  1 

PRNTAF 

00074 

Jt  «  • 

PRNTAF 

00075 

IF  (AMQCES.LT.J2)  J2  *  PMCCES 

PRdTAF 

00076 

IJl  3  1 

TRNTAF 

00077 

IJ2  3  (J2-1)  *  AMOCO  ♦  1 

PRNTAF 

00078 

C 

PRNTAF 

00079 

1100  Lite  3  LPOIX  ♦  10 

PRNTAF 

00090 

1110  DO  1200  I3l, AMOCO 

PRNTAF 

00091 

IF(LIAC.LE.LIACHX)  CO  TO  1110 

PRNTAF 

nnrM? 

MCE  3  PACE  ♦  1 

PRNTAF 

00093 

UAC  3  « 

PRNTAF 

00084 

MUTE  (AITS,  1001)  XMACH,*VL 

PRNTAF 

00085 

IFUO.Ca.2)  CO  TO  1140 

PRNTAF 

00096 

IF(PACE.CR.l)  CO  TO  1130 

PRNTAF 

00097 

MUTE  (AITS,  1303)  PC 

PRNTAF 

00098 

CO  TO  USD 

•RNTAF 

00089 

1130  CONTI  AM: 

PRNTAF 

00090 

MUTE  (NTS,  1003) 

PRNTAF 

00091 

CO  TO  USD 

PRNTAF 

00092 

1140  CONTI  AM 

PRNTAF 

00093 

IF  (FACC.O.l)  CO  TO  11S0 

PRNTAF 

00094 

MUTE  (NTS, 1013)  PC 

PRNTAF 

00093 

CO  TO  ItV 

PRNTAF 

00096 

1190  MUTE  (AITS,  101 3) 

PRNTAF 

00097 

USD  CONTI  AM 

PRNTAF 

00099 

C 

PRNTAF 

00099 

MUTE  (NTS »T00S) 

PRNTAF 

00100 

MUTE  (NTS, 1007)  (J.J3J1.J2) 

PRNTAF 

00101 

C 

PRNTAF 

00102 

1UD  CONTI  AM 

PRNTAF 

00103 

iFum.ei.2)  co  to  liM 

PRNTAF 

00104 

MUTt(NTS.SOlO)  I,  (CPAFCd  J) , I  J*IJ1,I  J2,AMQ0CS) 

PRNTAF 

00103 

SO  TO  1190 

PRNTAF 

00106 

1190  CONTINUE 

PRNTAF 

00107 

MUTE  (NTS.COIO)  I,  (CPPAFCII  J)  ,1  J*l  Jl , I  Jt,AMQ0CS) 

PRNTAF 

00109 

1190  CONTINUE 

PRNTAF 

00109 

UAC  3  LINE  ♦  1 

PRNTAF 

00110 

IJl  ■  IJl  ♦  1 

PRNTAF 

00111 

IJt  m  |J2  «! 

PRNTAF 

00112 
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FUNCTION  LCCSDWdRCW,  JCCL ,  I PNTSC ,  I PNTI N,  l PNTOT ,  I PNTLS) 

C 

C  RETURNS  THE  LOCATION  OF  THE  WCRD  IN  THE  E»C-ARQUM>  SUBDIVIDED 

C  OOWMASH  ARRAY  CORRESPOND! NO  TO  BOXdROW,  JCQL)  OF  THE  SUB- 

C  DIVIDED  BOX  ARRAY 

C 

C  IRON  =  BOX  CHCRDWISE  LOCATION 

C  JCCL  s  BOX  SPANHISE  LOCATION 

C  IPNTSD  =  ARRAY  OF  POINTERS 

C  I**NTIN  =  NEXT  AVAIUBLE  (UNUSED)  CELL  IN  IPNTSD  (END- 

C  AROUM)) 

C  IPNTOT  =  FIRST  CURRENTLY  AVAIUBLE  CELL  IN  IPNTSD 

C  IPNTLS  =  UST  CELL  OF  IPNTSD  (LENOTH  OF  ARRAY) 

C  RETURN  - 

C  LOCSDW  s  LOCATION  OF  DESIRED  DCVURSH,  IF  SUCCESSFUL 

C  *  0.  IF  LOCPNT  LIES  OUTSIDE  THE  DEFINED  AREA. 

C 

DIMENSION  IPNTSD (2 . IPNTLS) 

C 

LOCPNT  s  MOD (IRCVM t IPNTLS)  ♦  t 

LOCPNT  =  LOCATION  OF  CELL  IN  IPNTSD  WHICH  WAS  CR  IS  TO  BE 
USED 

IF  (I  PNTI  N  -  IPNTOT)  100  .  300  ,  200 
EM)  AROUM)  HAS  OCCURRED 
100  IF  (LOCPNT  -  IPNT1N)  400,  300,  ISO 

NOT  IN  UPPER  PART.  IS  LOCPNT  WITHIN  BOTTOM  PART  - 
ISO  IF  (LOCPNT  -  IPNTOT)  300  ,  400  ,  400 

NO  END  AROUM),  NCR  HAL  SEQUENCE 
200  IF  (LOCPNT  -  I  PNTI  N)  250,  300,  300 

LESS  THAN  UPPER  LIMIT.  IS  LOCPNT  .<£.  LOWER  LIMIT  - 
230  IF  (LOCPNT  .CE.  IPNTOT)  CO  TO  400 

ERROR  CR  INITIAL  CONDITION  ENCOUNTERED  (SHOULD  (EVER  OCCUR) 
ar,a  locscw  =  o 
CO  TO  300 

SUCCESSFUL,  BOX  HAS  BEEN  DEFINED 
400  I  PI  *  IPNTSD  (2, LOCPNT) 

IF(JCGL.LT.IFB)  CO  TO  300 
LOCSCW  s  I PNTSDd, LOCPNT)  ♦  4CCL-IFB 
C 

300  CONTINUE 
RETURN 
END 


LOCSCW 

00002 

LOCSCW 

00003 

LOCSCW 

00004 

LOCSDW 

00005 

LOCSDW 
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